Artifact
bdc6f1a441c4788fa0d2f34ea081e7a32801a08a:
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 54 68 69 73 20 66 69 ..;; .;; This fi
0080: 6c 65 20 69 73 20 70 61 72 74 20 6f 66 20 4d 65 le is part of Me
0090: 67 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 gatest..;; .;;
00a0: 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 20 66 Megatest is f
00b0: 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f ree software: yo
00c0: 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 u can redistribu
00d0: 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 te it and/or mod
00e0: 69 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 75 6e ify.;; it un
00f0: 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 der the terms of
0100: 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c the GNU General
0110: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0120: 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a as published by.
0130: 3b 3b 20 20 20 20 20 74 68 65 20 46 72 65 65 20 ;; the Free
0140: 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 Software Foundat
0150: 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 ion, either vers
0160: 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 ion 3 of the Lic
0170: 65 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 20 20 ense, or.;;
0180: 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 (at your option)
0190: 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 any later versi
01a0: 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d on..;; .;; M
01b0: 65 67 61 74 65 73 74 20 69 73 20 64 69 73 74 72 egatest is distr
01c0: 69 62 75 74 65 64 20 69 6e 20 74 68 65 20 68 6f ibuted in the ho
01d0: 70 65 20 74 68 61 74 20 69 74 20 77 69 6c 6c 20 pe that it will
01e0: 62 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 20 20 be useful,.;;
01f0: 20 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e but WITHOUT AN
0200: 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 Y WARRANTY; with
0210: 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 out even the imp
0220: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0230: 0a 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 4e 54 .;; MERCHANT
0240: 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 ABILITY or FITNE
0250: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 SS FOR A PARTICU
0260: 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 LAR PURPOSE. Se
0270: 65 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 4e 55 e the.;; GNU
0280: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
0290: 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 License for more
02a0: 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b details..;; .;;
02b0: 20 20 20 20 20 59 6f 75 20 73 68 6f 75 6c 64 20 You should
02c0: 68 61 76 65 20 72 65 63 65 69 76 65 64 20 61 20 have received a
02d0: 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e 55 20 copy of the GNU
02e0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
02f0: 69 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 61 6c icense.;; al
0300: 6f 6e 67 20 77 69 74 68 20 4d 65 67 61 74 65 73 ong with Megates
0310: 74 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 t. If not, see
0320: 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e <http://www.gnu.
0330: 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a org/licenses/>..
0340: 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;.;;===========
0350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 ===========..(us
0390: 65 20 66 6f 72 6d 61 74 29 0a 28 72 65 71 75 69 e format).(requi
03a0: 72 65 2d 6c 69 62 72 61 72 79 20 69 75 70 29 0a re-library iup).
03b0: 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
03c0: 69 75 70 20 69 75 70 3a 29 29 0a 28 75 73 65 20 iup iup:)).(use
03d0: 63 61 6e 76 61 73 2d 64 72 61 77 29 0a 28 69 6d canvas-draw).(im
03e0: 70 6f 72 74 20 63 61 6e 76 61 73 2d 64 72 61 77 port canvas-draw
03f0: 2d 69 75 70 29 0a 28 75 73 65 20 72 65 67 65 78 -iup).(use regex
0400: 20 74 79 70 65 64 2d 72 65 63 6f 72 64 73 20 6d typed-records m
0410: 61 74 63 68 61 62 6c 65 29 0a 0a 28 64 65 63 6c atchable)..(decl
0420: 61 72 65 20 28 75 6e 69 74 20 64 63 6f 6d 6d 6f are (unit dcommo
0430: 6e 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 n))..(declare (u
0440: 73 65 73 20 6d 65 67 61 74 65 73 74 2d 76 65 72 ses megatest-ver
0450: 73 69 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 sion)).(declare
0460: 28 75 73 65 73 20 67 75 74 69 6c 73 29 29 0a 28 (uses gutils)).(
0470: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 declare (uses db
0480: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
0490: 73 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 29 0a 28 69 s commonmod)).(i
04a0: 6d 70 6f 72 74 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 mport commonmod)
04b0: 0a 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 75 ..;; (declare (u
04c0: 73 65 73 20 73 79 6e 63 68 61 73 68 29 29 0a 0a ses synchash))..
04d0: 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e (include "common
04e0: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 _records.scm").(
04f0: 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 63 6f include "db_reco
0500: 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 rds.scm").(inclu
0510: 64 65 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e de "key_records.
0520: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
0530: 72 75 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 run_records.scm"
0540: 29 0a 0a 3b 3b 20 79 65 73 2c 20 74 68 69 73 20 )..;; yes, this
0550: 69 73 20 6e 6f 6e 2d 69 64 65 61 6c 20 0a 28 64 is non-ideal .(d
0560: 65 66 69 6e 65 20 64 61 73 68 62 6f 61 72 64 3a efine dashboard:
0570: 75 70 64 61 74 65 2d 73 75 6d 6d 61 72 79 2d 74 update-summary-t
0580: 61 62 20 23 66 29 0a 28 64 65 66 69 6e 65 20 64 ab #f).(define d
0590: 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d ashboard:update-
05a0: 73 65 72 76 65 72 73 2d 74 61 62 6c 65 20 23 66 servers-table #f
05b0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
05c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 ===========.;; C
0600: 20 4f 20 4d 20 4d 20 4f 20 4e 20 20 20 44 20 41 O M M O N D A
0610: 20 54 20 41 20 20 20 53 20 54 20 52 20 55 20 43 T A S T R U C
0620: 20 54 20 55 20 52 20 45 0a 3b 3b 3d 3d 3d 3d 3d T U R E.;;=====
0630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0670: 3d 0a 3b 3b 20 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d =.;; ..;;=======
0680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
06c0: 3b 3b 20 44 20 4f 20 54 20 46 20 49 20 4c 20 45 ;; D O T F I L E
06d0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
06e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
0720: 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 77 72 69 74 ne (dcommon:writ
0730: 65 2d 64 6f 74 66 69 6c 65 20 66 6e 61 6d 65 20 e-dotfile fname
0740: 64 61 74 29 0a 20 20 28 77 69 74 68 2d 6f 75 74 dat). (with-out
0750: 70 75 74 2d 74 6f 2d 66 69 6c 65 20 66 6e 61 6d put-to-file fnam
0760: 65 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 e. (lambda ()
0770: 0a 20 20 20 20 20 20 28 70 70 20 64 61 74 29 29 . (pp dat))
0780: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
0790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
07d0: 54 41 52 47 45 54 20 41 4e 44 20 50 41 54 54 45 TARGET AND PATTE
07e0: 52 4e 20 4d 41 4e 49 50 55 4c 41 54 49 4f 4e 53 RN MANIPULATIONS
07f0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
0800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 43 6f =========..;; Co
0840: 6e 76 65 72 74 20 74 6f 20 61 6e 64 20 66 72 6f nvert to and fro
0850: 6d 20 6c 69 73 74 20 6f 66 20 6c 69 6e 65 73 20 m list of lines
0860: 28 66 6f 72 20 61 20 74 65 78 74 20 62 6f 78 29 (for a text box)
0870: 0a 3b 3b 20 22 2c 22 20 3d 3e 20 22 5c 6e 22 0a .;; "," => "\n".
0880: 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a (define (dboard:
0890: 74 65 73 74 2d 70 61 74 74 2d 3e 6c 69 6e 65 73 test-patt->lines
08a0: 20 74 65 73 74 2d 70 61 74 74 29 0a 20 20 28 73 test-patt). (s
08b0: 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 tring-substitute
08c0: 20 28 72 65 67 65 78 70 20 22 2c 22 29 20 22 5c (regexp ",") "\
08d0: 6e 22 20 74 65 73 74 2d 70 61 74 74 29 29 0a 0a n" test-patt))..
08e0: 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a (define (dboard:
08f0: 6c 69 6e 65 73 2d 3e 74 65 73 74 2d 70 61 74 74 lines->test-patt
0900: 20 6c 69 6e 65 73 29 0a 20 20 28 73 74 72 69 6e lines). (strin
0910: 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 72 65 g-substitute (re
0920: 67 65 78 70 20 22 5c 6e 22 29 20 22 2c 22 20 6c gexp "\n") "," l
0930: 69 6e 65 73 20 23 74 29 29 0a 0a 0a 3b 3b 3d 3d ines #t))...;;==
0940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0980: 3d 3d 3d 3d 0a 3b 3b 20 50 20 52 20 4f 20 43 20 ====.;; P R O C
0990: 45 20 53 20 53 20 20 20 52 20 55 20 4e 20 53 0a E S S R U N S.
09a0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
09b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09e0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4d 4f 56 ========..;; MOV
09f0: 45 20 54 48 49 53 20 49 4e 54 4f 20 2a 64 61 74 E THIS INTO *dat
0a00: 61 2a 0a 28 64 65 66 69 6e 65 20 2a 63 61 63 68 a*.(define *cach
0a10: 65 64 61 74 61 2a 20 28 6d 61 6b 65 2d 68 61 73 edata* (make-has
0a20: 68 2d 74 61 62 6c 65 29 29 0a 28 68 61 73 68 2d h-table)).(hash-
0a30: 74 61 62 6c 65 2d 73 65 74 21 20 2a 63 61 63 68 table-set! *cach
0a40: 65 64 61 74 61 2a 20 22 72 75 6e 69 64 2d 74 6f edata* "runid-to
0a50: 2d 63 6f 6c 22 20 20 20 20 28 6d 61 6b 65 2d 68 -col" (make-h
0a60: 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 68 61 73 ash-table)).(has
0a70: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 63 61 h-table-set! *ca
0a80: 63 68 65 64 61 74 61 2a 20 22 74 65 73 74 6e 61 chedata* "testna
0a90: 6d 65 2d 74 6f 2d 72 6f 77 22 20 28 6d 61 6b 65 me-to-row" (make
0aa0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 0a 3b -hash-table))..;
0ab0: 3b 20 6d 6f 64 69 66 79 20 61 20 63 65 6c 6c 20 ; modify a cell
0ac0: 69 66 20 74 68 65 20 64 61 74 61 20 69 73 20 63 if the data is c
0ad0: 68 61 6e 67 65 64 2c 20 72 65 74 75 72 6e 20 23 hanged, return #
0ae0: 74 20 6f 72 2d 65 64 20 77 69 74 68 20 70 72 65 t or-ed with pre
0af0: 76 69 6f 75 73 20 69 66 20 6d 6f 64 69 66 69 65 vious if modifie
0b00: 64 2c 20 23 66 20 65 6c 73 65 77 69 73 65 0a 3b d, #f elsewise.;
0b10: 3b 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d ;.(define (dcomm
0b20: 6f 6e 3a 6d 6f 64 69 66 69 79 2d 69 66 2d 64 69 on:modifiy-if-di
0b30: 66 66 65 72 65 6e 74 20 6d 74 72 78 20 63 65 6c fferent mtrx cel
0b40: 6c 2d 6e 61 6d 65 20 6e 65 77 2d 76 61 6c 20 70 l-name new-val p
0b50: 72 65 76 2d 63 68 61 6e 67 65 64 29 0a 20 20 28 rev-changed). (
0b60: 6c 65 74 20 28 28 63 75 72 72 2d 76 61 6c 20 28 let ((curr-val (
0b70: 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6d 74 iup:attribute mt
0b80: 72 78 20 63 65 6c 6c 2d 6e 61 6d 65 29 29 29 0a rx cell-name))).
0b90: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 (if (not (eq
0ba0: 75 61 6c 3f 20 63 75 72 72 2d 76 61 6c 20 6e 65 ual? curr-val ne
0bb0: 77 2d 76 61 6c 29 29 20 0a 09 28 62 65 67 69 6e w-val)) ..(begin
0bc0: 0a 09 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 .. (iup:attribu
0bd0: 74 65 2d 73 65 74 21 20 6d 74 72 78 20 63 65 6c te-set! mtrx cel
0be0: 6c 2d 6e 61 6d 65 20 63 6f 6c 2d 6e 61 6d 65 29 l-name col-name)
0bf0: 0a 09 20 20 23 74 29 20 3b 3b 20 6e 65 65 64 20 .. #t) ;; need
0c00: 61 20 72 65 2d 64 72 61 77 0a 09 70 72 65 76 2d a re-draw..prev-
0c10: 63 68 61 6e 67 65 64 29 29 29 0a 0a 0a 3b 3b 20 changed)))...;;
0c20: 54 4f 2d 44 4f 0a 3b 3b 20 20 31 2e 20 4d 61 6b TO-DO.;; 1. Mak
0c30: 65 20 22 64 61 74 61 22 20 68 61 73 68 2d 74 61 e "data" hash-ta
0c40: 62 6c 65 20 68 69 65 72 61 72 63 68 69 61 6c 20 ble hierarchial
0c50: 73 74 6f 72 65 20 6f 66 20 61 6c 6c 20 64 69 73 store of all dis
0c60: 70 6c 61 79 65 64 20 64 61 74 61 0a 3b 3b 20 20 played data.;;
0c70: 32 2e 20 55 70 64 61 74 65 20 73 79 6e 63 68 61 2. Update syncha
0c80: 73 68 20 74 6f 20 75 6e 64 65 72 73 74 61 6e 64 sh to understand
0c90: 20 22 67 65 74 2d 72 75 6e 73 22 2c 20 22 67 65 "get-runs", "ge
0ca0: 74 2d 74 65 73 74 73 22 20 65 74 63 2e 0a 3b 3b t-tests" etc..;;
0cb0: 20 20 33 2e 20 41 64 64 20 65 78 74 72 61 63 74 3. Add extract
0cc0: 69 6f 6e 20 6f 66 20 66 69 6c 74 65 72 73 20 74 ion of filters t
0cd0: 6f 20 73 79 6e 63 68 61 73 68 20 63 61 6c 6c 73 o synchash calls
0ce0: 0a 3b 3b 0a 3b 3b 20 20 20 20 4e 4f 54 45 3a 20 .;;.;; NOTE:
0cf0: 55 73 65 64 20 69 6e 20 6e 65 77 64 61 73 68 62 Used in newdashb
0d00: 6f 61 72 64 0a 3b 3b 0a 3b 3b 20 4d 6f 64 65 20 oard.;;.;; Mode
0d10: 69 73 20 27 66 75 6c 6c 20 6f 72 20 27 69 6e 63 is 'full or 'inc
0d20: 72 65 6d 65 6e 74 61 6c 20 66 6f 72 20 66 75 6c remental for ful
0d30: 6c 20 72 65 66 72 65 73 68 20 6f 72 20 69 6e 63 l refresh or inc
0d40: 72 65 6d 65 6e 74 61 6c 20 72 65 66 72 65 73 68 remental refresh
0d50: 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 64 63 6f .;; (define (dco
0d60: 6d 6d 6f 6e 3a 72 75 6e 2d 75 70 64 61 74 65 20 mmon:run-update
0d70: 6b 65 79 73 20 64 61 74 61 20 72 75 6e 6e 61 6d keys data runnam
0d80: 65 20 6b 65 79 70 61 74 74 73 20 74 65 73 74 70 e keypatts testp
0d90: 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 75 att states statu
0da0: 73 65 73 20 6d 6f 64 65 20 77 69 6e 64 6f 77 2d ses mode window-
0db0: 69 64 29 0a 3b 3b 20 20 20 28 6c 65 74 2a 20 28 id).;; (let* (
0dc0: 3b 3b 20 63 6f 75 6e 74 20 61 6e 64 20 6f 66 66 ;; count and off
0dd0: 73 65 74 20 3d 3e 20 23 66 20 73 6f 20 6e 6f 74 set => #f so not
0de0: 20 75 73 65 64 0a 3b 3b 20 09 20 3b 3b 20 74 68 used.;; . ;; th
0df0: 65 20 73 79 6e 63 68 61 73 68 20 63 61 6c 6c 73 e synchash calls
0e00: 20 6d 6f 64 69 66 79 20 74 68 65 20 22 64 61 74 modify the "dat
0e10: 61 22 20 68 61 73 68 0a 3b 3b 20 09 20 28 63 68 a" hash.;; . (ch
0e20: 61 6e 67 65 64 20 20 20 20 20 20 20 20 20 23 66 anged #f
0e30: 29 0a 3b 3b 20 09 20 28 67 65 74 2d 72 75 6e 73 ).;; . (get-runs
0e40: 2d 73 69 67 20 20 20 20 28 63 6f 6e 63 20 28 63 -sig (conc (c
0e50: 6c 69 65 6e 74 3a 67 65 74 2d 73 69 67 6e 61 74 lient:get-signat
0e60: 75 72 65 29 20 22 20 67 65 74 2d 72 75 6e 73 22 ure) " get-runs"
0e70: 29 29 0a 3b 3b 20 09 20 28 67 65 74 2d 74 65 73 )).;; . (get-tes
0e80: 74 73 2d 73 69 67 20 20 20 28 63 6f 6e 63 20 28 ts-sig (conc (
0e90: 63 6c 69 65 6e 74 3a 67 65 74 2d 73 69 67 6e 61 client:get-signa
0ea0: 74 75 72 65 29 20 22 20 67 65 74 2d 74 65 73 74 ture) " get-test
0eb0: 73 22 29 29 0a 3b 3b 20 09 20 28 67 65 74 2d 64 s")).;; . (get-d
0ec0: 65 74 61 69 6c 73 2d 73 69 67 20 28 63 6f 6e 63 etails-sig (conc
0ed0: 20 28 63 6c 69 65 6e 74 3a 67 65 74 2d 73 69 67 (client:get-sig
0ee0: 6e 61 74 75 72 65 29 20 22 20 67 65 74 2d 74 65 nature) " get-te
0ef0: 73 74 2d 64 65 74 61 69 6c 73 22 29 29 0a 3b 3b st-details")).;;
0f00: 20 0a 3b 3b 20 09 20 3b 3b 20 74 65 73 74 2d 69 .;; . ;; test-i
0f10: 64 73 20 74 6f 20 67 65 74 20 61 6e 64 20 64 69 ds to get and di
0f20: 73 70 6c 61 79 20 61 72 65 20 69 6e 64 65 78 65 splay are indexe
0f30: 64 20 6f 6e 20 77 69 6e 64 6f 77 2d 69 64 20 69 d on window-id i
0f40: 6e 20 63 75 72 72 2d 74 65 73 74 2d 69 64 73 20 n curr-test-ids
0f50: 68 61 73 68 0a 3b 3b 20 09 20 28 74 65 73 74 2d hash.;; . (test-
0f60: 69 64 73 20 20 20 20 20 20 20 20 28 68 61 73 68 ids (hash
0f70: 2d 74 61 62 6c 65 2d 76 61 6c 75 65 73 20 28 64 -table-values (d
0f80: 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 63 75 72 board:tabdat-cur
0f90: 72 2d 74 65 73 74 2d 69 64 73 20 64 61 74 61 29 r-test-ids data)
0fa0: 29 29 0a 3b 3b 20 09 20 3b 3b 20 72 75 6e 2d 69 )).;; . ;; run-i
0fb0: 64 20 69 73 20 23 66 20 69 6e 20 6e 65 78 74 20 d is #f in next
0fc0: 6c 69 6e 65 20 74 6f 20 73 65 6e 64 20 74 68 65 line to send the
0fd0: 20 71 75 65 72 79 20 74 6f 20 73 65 72 76 65 72 query to server
0fe0: 20 30 0a 3b 3b 20 20 09 20 28 72 75 6e 2d 63 68 0.;; . (run-ch
0ff0: 61 6e 67 65 73 20 20 20 20 20 28 73 79 6e 63 68 anges (synch
1000: 61 73 68 3a 63 6c 69 65 6e 74 2d 67 65 74 20 27 ash:client-get '
1010: 64 62 3a 67 65 74 2d 72 75 6e 73 20 67 65 74 2d db:get-runs get-
1020: 72 75 6e 73 2d 73 69 67 20 28 6c 65 6e 67 74 68 runs-sig (length
1030: 20 6b 65 79 70 61 74 74 73 29 20 64 61 74 61 20 keypatts) data
1040: 23 66 20 72 75 6e 6e 61 6d 65 20 23 66 20 23 66 #f runname #f #f
1050: 20 6b 65 79 70 61 74 74 73 29 29 0a 3b 3b 20 09 keypatts)).;; .
1060: 20 28 74 65 73 74 73 2d 64 65 74 61 69 6c 2d 63 (tests-detail-c
1070: 68 61 6e 67 65 73 20 28 69 66 20 28 6e 6f 74 20 hanges (if (not
1080: 28 6e 75 6c 6c 3f 20 74 65 73 74 2d 69 64 73 29 (null? test-ids)
1090: 29 0a 3b 3b 20 09 09 09 09 20 20 20 28 73 79 6e ).;; .... (syn
10a0: 63 68 61 73 68 3a 63 6c 69 65 6e 74 2d 67 65 74 chash:client-get
10b0: 20 27 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 'db:get-test-in
10c0: 66 6f 2d 62 79 2d 69 64 73 20 67 65 74 2d 64 65 fo-by-ids get-de
10d0: 74 61 69 6c 73 2d 73 69 67 20 30 20 20 64 61 74 tails-sig 0 dat
10e0: 61 20 23 66 20 74 65 73 74 2d 69 64 73 29 0a 3b a #f test-ids).;
10f0: 3b 20 09 09 09 09 20 20 20 27 28 29 29 29 0a 3b ; .... '())).;
1100: 3b 20 0a 3b 3b 20 09 20 3b 3b 20 4e 6f 77 20 63 ; .;; . ;; Now c
1110: 61 6e 20 63 61 6c 63 75 6c 61 74 65 20 74 68 65 an calculate the
1120: 20 72 75 6e 2d 69 64 73 0a 3b 3b 20 09 20 28 72 run-ids.;; . (r
1130: 75 6e 2d 68 61 73 68 20 20 20 20 28 68 61 73 68 un-hash (hash
1140: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
1150: 6c 74 20 64 61 74 61 20 67 65 74 2d 72 75 6e 73 lt data get-runs
1160: 2d 73 69 67 20 23 66 29 29 0a 3b 3b 20 09 20 28 -sig #f)).;; . (
1170: 72 75 6e 2d 69 64 73 20 20 20 20 20 28 69 66 20 run-ids (if
1180: 72 75 6e 2d 68 61 73 68 20 28 66 69 6c 74 65 72 run-hash (filter
1190: 20 6e 75 6d 62 65 72 3f 20 28 68 61 73 68 2d 74 number? (hash-t
11a0: 61 62 6c 65 2d 6b 65 79 73 20 72 75 6e 2d 68 61 able-keys run-ha
11b0: 73 68 29 29 20 27 28 29 29 29 0a 3b 3b 20 0a 3b sh)) '())).;; .;
11c0: 3b 20 09 20 28 61 6c 6c 2d 74 65 73 74 2d 63 68 ; . (all-test-ch
11d0: 61 6e 67 65 73 20 28 6c 65 74 20 28 28 72 65 73 anges (let ((res
11e0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
11f0: 65 29 29 29 0a 3b 3b 20 09 09 09 20 20 20 20 20 e))).;; ...
1200: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
1210: 61 20 28 72 75 6e 2d 69 64 29 0a 3b 3b 20 09 09 a (run-id).;; ..
1220: 09 09 09 20 28 69 66 20 28 3e 20 72 75 6e 2d 69 ... (if (> run-i
1230: 64 20 30 29 0a 3b 3b 20 09 09 09 09 09 20 20 20 d 0).;; .....
1240: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
1250: 74 21 20 72 65 73 20 72 75 6e 2d 69 64 20 28 73 t! res run-id (s
1260: 79 6e 63 68 61 73 68 3a 63 6c 69 65 6e 74 2d 67 ynchash:client-g
1270: 65 74 20 27 64 62 3a 67 65 74 2d 74 65 73 74 73 et 'db:get-tests
1280: 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 -for-run-mindata
1290: 20 67 65 74 2d 74 65 73 74 73 2d 73 69 67 20 30 get-tests-sig 0
12a0: 20 64 61 74 61 20 72 75 6e 2d 69 64 20 31 20 74 data run-id 1 t
12b0: 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 estpatt states s
12c0: 74 61 74 75 73 65 73 20 23 66 29 29 29 29 0a 3b tatuses #f)))).;
12d0: 3b 20 09 09 09 09 20 20 20 20 20 20 20 72 75 6e ; .... run
12e0: 2d 69 64 73 29 0a 3b 3b 20 09 09 09 20 20 20 20 -ids).;; ...
12f0: 20 72 65 73 29 29 0a 3b 3b 20 09 20 28 72 75 6e res)).;; . (run
1300: 73 2d 68 61 73 68 20 20 20 20 28 68 61 73 68 2d s-hash (hash-
1310: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
1320: 74 20 64 61 74 61 20 67 65 74 2d 72 75 6e 73 2d t data get-runs-
1330: 73 69 67 20 23 66 29 29 0a 3b 3b 20 09 20 28 68 sig #f)).;; . (h
1340: 65 61 64 65 72 20 20 20 20 20 20 20 28 68 61 73 eader (has
1350: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
1360: 75 6c 74 20 72 75 6e 73 2d 68 61 73 68 20 22 68 ult runs-hash "h
1370: 65 61 64 65 72 22 20 23 66 29 29 0a 3b 3b 20 09 eader" #f)).;; .
1380: 20 28 72 75 6e 2d 69 64 73 20 20 20 20 20 20 28 (run-ids (
1390: 73 6f 72 74 20 28 66 69 6c 74 65 72 20 6e 75 6d sort (filter num
13a0: 62 65 72 3f 20 28 68 61 73 68 2d 74 61 62 6c 65 ber? (hash-table
13b0: 2d 6b 65 79 73 20 72 75 6e 73 2d 68 61 73 68 29 -keys runs-hash)
13c0: 29 0a 3b 3b 20 09 09 09 20 20 20 20 20 28 6c 61 ).;; ... (la
13d0: 6d 62 64 61 20 28 61 20 62 29 0a 3b 3b 20 09 09 mbda (a b).;; ..
13e0: 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
13f0: 72 65 63 6f 72 64 2d 61 20 28 68 61 73 68 2d 74 record-a (hash-t
1400: 61 62 6c 65 2d 72 65 66 20 72 75 6e 73 2d 68 61 able-ref runs-ha
1410: 73 68 20 61 29 29 0a 3b 3b 20 09 09 09 09 20 20 sh a)).;; ....
1420: 20 20 20 20 28 72 65 63 6f 72 64 2d 62 20 28 68 (record-b (h
1430: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 72 75 ash-table-ref ru
1440: 6e 73 2d 68 61 73 68 20 62 29 29 0a 3b 3b 20 09 ns-hash b)).;; .
1450: 09 09 09 20 20 20 20 20 20 28 74 69 6d 65 2d 61 ... (time-a
1460: 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 (db:get-value
1470: 2d 62 79 2d 68 65 61 64 65 72 20 72 65 63 6f 72 -by-header recor
1480: 64 2d 61 20 68 65 61 64 65 72 20 22 65 76 65 6e d-a header "even
1490: 74 5f 74 69 6d 65 22 29 29 0a 3b 3b 20 09 09 09 t_time")).;; ...
14a0: 09 20 20 20 20 20 20 28 74 69 6d 65 2d 62 20 20 . (time-b
14b0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
14c0: 79 2d 68 65 61 64 65 72 20 72 65 63 6f 72 64 2d y-header record-
14d0: 62 20 68 65 61 64 65 72 20 22 65 76 65 6e 74 5f b header "event_
14e0: 74 69 6d 65 22 29 29 29 0a 3b 3b 20 09 09 09 09 time"))).;; ....
14f0: 20 28 3e 20 74 69 6d 65 2d 61 20 74 69 6d 65 2d (> time-a time-
1500: 62 29 29 29 0a 3b 3b 20 09 09 09 20 20 20 20 20 b))).;; ...
1510: 29 29 0a 3b 3b 20 09 20 28 72 75 6e 69 64 2d 74 )).;; . (runid-t
1520: 6f 2d 63 6f 6c 20 20 20 20 28 68 61 73 68 2d 74 o-col (hash-t
1530: 61 62 6c 65 2d 72 65 66 20 2a 63 61 63 68 65 64 able-ref *cached
1540: 61 74 61 2a 20 22 72 75 6e 69 64 2d 74 6f 2d 63 ata* "runid-to-c
1550: 6f 6c 22 29 29 0a 3b 3b 20 09 20 28 74 65 73 74 ol")).;; . (test
1560: 6e 61 6d 65 2d 74 6f 2d 72 6f 77 20 28 68 61 73 name-to-row (has
1570: 68 2d 74 61 62 6c 65 2d 72 65 66 20 2a 63 61 63 h-table-ref *cac
1580: 68 65 64 61 74 61 2a 20 22 74 65 73 74 6e 61 6d hedata* "testnam
1590: 65 2d 74 6f 2d 72 6f 77 22 29 29 20 0a 3b 3b 20 e-to-row")) .;;
15a0: 09 20 28 63 6f 6c 6e 75 6d 20 20 20 20 20 20 20 . (colnum
15b0: 31 29 0a 3b 3b 20 09 20 28 72 6f 77 6e 75 6d 20 1).;; . (rownum
15c0: 20 20 20 20 20 20 30 29 0a 3b 3b 20 09 20 28 63 0).;; . (c
15d0: 65 6c 6c 6e 61 6d 65 20 28 63 6f 6e 63 20 72 6f ellname (conc ro
15e0: 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 wnum ":" colnum)
15f0: 29 29 20 3b 3b 20 72 6f 77 6e 75 6d 20 3d 20 30 )) ;; rownum = 0
1600: 20 69 73 20 74 68 65 20 68 65 61 64 65 72 0a 3b is the header.;
1610: 3b 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e ; ;; (debug:prin
1620: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
1630: 2d 70 6f 72 74 2a 20 22 74 65 73 74 2d 69 64 73 -port* "test-ids
1640: 20 22 20 74 65 73 74 2d 69 64 73 20 22 2c 20 74 " test-ids ", t
1650: 65 73 74 73 2d 64 65 74 61 69 6c 2d 63 68 61 6e ests-detail-chan
1660: 67 65 73 20 22 20 74 65 73 74 73 2d 64 65 74 61 ges " tests-deta
1670: 69 6c 2d 63 68 61 6e 67 65 73 29 0a 3b 3b 20 20 il-changes).;;
1680: 20 20 20 0a 3b 3b 20 09 20 3b 3b 20 74 65 73 74 .;; . ;; test
1690: 73 20 72 65 6c 61 74 65 64 20 73 74 75 66 66 0a s related stuff.
16a0: 3b 3b 20 09 20 3b 3b 20 28 61 6c 6c 2d 74 65 73 ;; . ;; (all-tes
16b0: 74 6e 61 6d 65 73 20 28 64 65 6c 65 74 65 2d 64 tnames (delete-d
16c0: 75 70 6c 69 63 61 74 65 73 20 28 6d 61 70 20 64 uplicates (map d
16d0: 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn
16e0: 61 6d 65 20 74 65 73 74 2d 63 68 61 6e 67 65 73 ame test-changes
16f0: 29 29 29 29 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 )))).;; .;;
1700: 3b 3b 20 47 69 76 65 6e 20 61 20 72 75 6e 2d 69 ;; Given a run-i
1710: 64 20 61 6e 64 20 74 65 73 74 6e 61 6d 65 2f 69 d and testname/i
1720: 74 65 6d 5f 70 61 74 68 20 63 61 6c 63 75 6c 61 tem_path calcula
1730: 74 65 20 61 20 63 65 6c 6c 20 52 3a 43 0a 3b 3b te a cell R:C.;;
1740: 20 0a 3b 3b 20 20 20 20 20 3b 3b 20 4e 4f 54 45 .;; ;; NOTE
1750: 3a 20 41 6c 73 6f 20 62 75 69 6c 64 20 74 68 65 : Also build the
1760: 20 74 65 73 74 20 74 72 65 65 20 62 72 6f 77 73 test tree brows
1770: 65 72 20 61 6e 64 20 6c 6f 6f 6b 20 75 70 20 74 er and look up t
1780: 61 62 6c 65 0a 3b 3b 20 20 20 20 20 3b 3b 0a 3b able.;; ;;.;
1790: 3b 20 20 20 20 20 3b 3b 20 45 61 63 68 20 72 75 ; ;; Each ru
17a0: 6e 20 69 73 20 75 6e 69 71 75 65 20 6f 6e 20 69 n is unique on i
17b0: 74 73 20 6b 65 79 73 20 61 6e 64 20 72 75 6e 6e ts keys and runn
17c0: 61 6d 65 20 6f 72 20 72 75 6e 2d 69 64 2c 20 73 ame or run-id, s
17d0: 74 6f 72 65 20 69 6e 20 68 61 73 68 20 6f 6e 20 tore in hash on
17e0: 63 6f 6c 6e 75 6d 0a 3b 3b 20 20 20 20 20 28 66 colnum.;; (f
17f0: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
1800: 28 72 75 6e 2d 69 64 29 0a 3b 3b 20 09 09 28 6c (run-id).;; ..(l
1810: 65 74 2a 20 28 28 72 75 6e 2d 72 65 63 6f 72 64 et* ((run-record
1820: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
1830: 2f 64 65 66 61 75 6c 74 20 72 75 6e 73 2d 68 61 /default runs-ha
1840: 73 68 20 72 75 6e 2d 69 64 20 23 66 29 29 0a 3b sh run-id #f)).;
1850: 3b 20 09 09 20 20 20 20 20 20 20 28 6b 65 79 2d ; .. (key-
1860: 76 61 6c 73 20 20 20 28 6d 61 70 20 28 6c 61 6d vals (map (lam
1870: 62 64 61 20 28 6b 65 79 29 28 64 62 3a 67 65 74 bda (key)(db:get
1880: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
1890: 20 72 75 6e 2d 72 65 63 6f 72 64 20 68 65 61 64 run-record head
18a0: 65 72 20 6b 65 79 29 29 0a 3b 3b 20 09 09 09 09 er key)).;; ....
18b0: 09 6b 65 79 73 29 29 0a 3b 3b 20 09 09 20 20 20 .keys)).;; ..
18c0: 20 20 20 20 28 72 75 6e 2d 6e 61 6d 65 20 20 20 (run-name
18d0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
18e0: 2d 68 65 61 64 65 72 20 72 75 6e 2d 72 65 63 6f -header run-reco
18f0: 72 64 20 68 65 61 64 65 72 20 22 72 75 6e 6e 61 rd header "runna
1900: 6d 65 22 29 29 0a 3b 3b 20 09 09 20 20 20 20 20 me")).;; ..
1910: 20 20 28 63 6f 6c 2d 6e 61 6d 65 20 20 20 28 63 (col-name (c
1920: 6f 6e 63 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 onc (string-inte
1930: 72 73 70 65 72 73 65 20 6b 65 79 2d 76 61 6c 73 rsperse key-vals
1940: 20 22 5c 6e 22 29 20 22 5c 6e 22 20 72 75 6e 2d "\n") "\n" run-
1950: 6e 61 6d 65 29 29 0a 3b 3b 20 09 09 20 20 20 20 name)).;; ..
1960: 20 20 20 28 72 75 6e 2d 70 61 74 68 20 20 20 28 (run-path (
1970: 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 6c 73 20 append key-vals
1980: 28 6c 69 73 74 20 72 75 6e 2d 6e 61 6d 65 29 29 (list run-name))
1990: 29 29 0a 3b 3b 20 09 09 20 20 28 68 61 73 68 2d )).;; .. (hash-
19a0: 74 61 62 6c 65 2d 73 65 74 21 20 28 64 62 6f 61 table-set! (dboa
19b0: 72 64 3a 74 61 62 64 61 74 2d 72 75 6e 2d 6b 65 rd:tabdat-run-ke
19c0: 79 73 20 64 61 74 61 29 20 72 75 6e 2d 69 64 20 ys data) run-id
19d0: 72 75 6e 2d 70 61 74 68 29 0a 3b 3b 20 09 09 20 run-path).;; ..
19e0: 20 3b 3b 20 6d 6f 64 69 66 79 20 63 65 6c 6c 20 ;; modify cell
19f0: 2d 20 62 75 74 20 6f 6e 6c 79 20 69 66 20 63 68 - but only if ch
1a00: 61 6e 67 65 64 0a 3b 3b 20 09 09 20 20 28 73 65 anged.;; .. (se
1a10: 74 21 20 63 68 61 6e 67 65 64 20 28 64 63 6f 6d t! changed (dcom
1a20: 6d 6f 6e 3a 6d 6f 64 69 66 69 79 2d 69 66 2d 64 mon:modifiy-if-d
1a30: 69 66 66 65 72 65 6e 74 20 28 64 62 6f 61 72 64 ifferent (dboard
1a40: 3a 74 61 62 64 61 74 2d 72 75 6e 73 2d 6d 61 74 :tabdat-runs-mat
1a50: 72 69 78 20 64 61 74 61 29 20 63 65 6c 6c 6e 61 rix data) cellna
1a60: 6d 65 20 63 6f 6c 2d 6e 61 6d 65 20 63 68 61 6e me col-name chan
1a70: 67 65 64 29 29 0a 3b 3b 20 09 09 20 20 28 68 61 ged)).;; .. (ha
1a80: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 75 sh-table-set! ru
1a90: 6e 69 64 2d 74 6f 2d 63 6f 6c 20 72 75 6e 2d 69 nid-to-col run-i
1aa0: 64 20 28 6c 69 73 74 20 63 6f 6c 6e 75 6d 20 72 d (list colnum r
1ab0: 75 6e 2d 72 65 63 6f 72 64 29 29 0a 3b 3b 20 09 un-record)).;; .
1ac0: 09 20 20 3b 3b 20 48 65 72 65 20 77 65 20 75 70 . ;; Here we up
1ad0: 64 61 74 65 20 74 68 65 20 74 65 73 74 73 20 74 date the tests t
1ae0: 72 65 65 62 6f 78 20 61 6e 64 20 74 72 65 65 20 reebox and tree
1af0: 6b 65 79 73 0a 3b 3b 20 09 09 20 20 28 74 72 65 keys.;; .. (tre
1b00: 65 3a 61 64 64 2d 6e 6f 64 65 20 28 64 62 6f 61 e:add-node (dboa
1b10: 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 73 2d rd:tabdat-tests-
1b20: 74 72 65 65 20 64 61 74 61 29 20 22 52 75 6e 73 tree data) "Runs
1b30: 22 20 28 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 " (append key-va
1b40: 6c 73 20 28 6c 69 73 74 20 72 75 6e 2d 6e 61 6d ls (list run-nam
1b50: 65 29 29 0a 3b 3b 20 09 09 09 09 20 75 73 65 72 e)).;; .... user
1b60: 64 61 74 61 3a 20 28 63 6f 6e 63 20 22 72 75 6e data: (conc "run
1b70: 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 29 29 0a -id: " run-id)).
1b80: 3b 3b 20 09 09 20 20 28 73 65 74 21 20 63 6f 6c ;; .. (set! col
1b90: 6e 75 6d 20 28 2b 20 63 6f 6c 6e 75 6d 20 31 29 num (+ colnum 1)
1ba0: 29 29 29 0a 3b 3b 20 09 20 20 20 20 20 20 72 75 ))).;; . ru
1bb0: 6e 2d 69 64 73 29 0a 3b 3b 20 0a 3b 3b 20 20 20 n-ids).;; .;;
1bc0: 20 20 3b 3b 20 53 63 61 6e 20 61 6c 6c 20 74 65 ;; Scan all te
1bd0: 73 74 73 20 74 6f 20 62 65 20 64 69 73 70 6c 61 sts to be displa
1be0: 79 65 64 20 61 6e 64 20 6f 72 67 61 6e 69 73 65 yed and organise
1bf0: 20 61 6c 6c 20 74 68 65 20 74 65 73 74 20 6e 61 all the test na
1c00: 6d 65 73 2c 20 72 65 73 70 65 63 74 69 6e 67 20 mes, respecting
1c10: 77 68 61 74 20 69 73 20 69 6e 20 74 68 65 20 68 what is in the h
1c20: 61 73 68 20 74 61 62 6c 65 0a 3b 3b 20 20 20 20 ash table.;;
1c30: 20 3b 3b 20 44 6f 20 74 68 69 73 20 61 6e 61 6c ;; Do this anal
1c40: 79 73 69 73 20 69 6e 20 74 68 65 20 6f 72 64 65 ysis in the orde
1c50: 72 20 6f 66 20 74 68 65 20 72 75 6e 2d 69 64 73 r of the run-ids
1c60: 2c 20 74 68 65 20 6d 6f 73 74 20 72 65 63 65 6e , the most recen
1c70: 74 20 72 75 6e 20 77 69 6e 73 0a 3b 3b 20 20 20 t run wins.;;
1c80: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
1c90: 62 64 61 20 28 72 75 6e 2d 69 64 29 0a 3b 3b 20 bda (run-id).;;
1ca0: 09 09 28 6c 65 74 2a 20 28 28 72 75 6e 2d 70 61 ..(let* ((run-pa
1cb0: 74 68 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 th (hash-t
1cc0: 61 62 6c 65 2d 72 65 66 20 28 64 62 6f 61 72 64 able-ref (dboard
1cd0: 3a 74 61 62 64 61 74 2d 72 75 6e 2d 6b 65 79 73 :tabdat-run-keys
1ce0: 20 64 61 74 61 29 20 72 75 6e 2d 69 64 29 29 0a data) run-id)).
1cf0: 3b 3b 20 09 09 20 20 20 20 20 20 20 28 74 65 73 ;; .. (tes
1d00: 74 2d 63 68 61 6e 67 65 73 20 20 20 28 68 61 73 t-changes (has
1d10: 68 2d 74 61 62 6c 65 2d 72 65 66 20 61 6c 6c 2d h-table-ref all-
1d20: 74 65 73 74 2d 63 68 61 6e 67 65 73 20 72 75 6e test-changes run
1d30: 2d 69 64 29 29 0a 3b 3b 20 09 09 20 20 20 20 20 -id)).;; ..
1d40: 20 20 28 6e 65 77 2d 74 65 73 74 2d 64 61 74 20 (new-test-dat
1d50: 20 20 28 63 61 72 20 74 65 73 74 2d 63 68 61 6e (car test-chan
1d60: 67 65 73 29 29 0a 3b 3b 20 09 09 20 20 20 20 20 ges)).;; ..
1d70: 20 20 28 72 65 6d 6f 76 65 64 2d 74 65 73 74 73 (removed-tests
1d80: 20 20 28 63 61 64 72 20 74 65 73 74 2d 63 68 61 (cadr test-cha
1d90: 6e 67 65 73 29 29 0a 3b 3b 20 09 09 20 20 20 20 nges)).;; ..
1da0: 20 20 20 28 74 65 73 74 73 20 20 20 20 20 20 20 (tests
1db0: 20 20 20 28 73 6f 72 74 20 28 6d 61 70 20 63 61 (sort (map ca
1dc0: 64 72 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 dr (filter (lamb
1dd0: 64 61 20 28 74 65 73 74 72 65 63 29 0a 3b 3b 20 da (testrec).;;
1de0: 09 09 09 09 09 09 09 09 20 28 65 71 3f 20 72 75 ........ (eq? ru
1df0: 6e 2d 69 64 20 28 64 62 3a 6d 69 6e 74 65 73 74 n-id (db:mintest
1e00: 2d 67 65 74 2d 72 75 6e 5f 69 64 20 28 63 61 64 -get-run_id (cad
1e10: 72 20 74 65 73 74 72 65 63 29 29 29 29 0a 3b 3b r testrec)))).;;
1e20: 20 09 09 09 09 09 09 09 20 20 20 20 20 20 20 6e ....... n
1e30: 65 77 2d 74 65 73 74 2d 64 61 74 29 29 0a 3b 3b ew-test-dat)).;;
1e40: 20 09 09 09 09 09 20 20 20 20 20 28 6c 61 6d 62 ..... (lamb
1e50: 64 61 20 28 61 20 62 29 0a 3b 3b 20 09 09 09 09 da (a b).;; ....
1e60: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 . (let ((t
1e70: 69 6d 65 2d 61 20 28 64 62 3a 6d 69 6e 74 65 73 ime-a (db:mintes
1e80: 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 t-get-event_time
1e90: 20 61 29 29 0a 3b 3b 20 09 09 09 09 09 09 20 20 a)).;; ......
1ea0: 20 20 20 28 74 69 6d 65 2d 62 20 28 64 62 3a 6d (time-b (db:m
1eb0: 69 6e 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 intest-get-event
1ec0: 5f 74 69 6d 65 20 62 29 29 29 0a 3b 3b 20 09 09 _time b))).;; ..
1ed0: 09 09 09 09 20 28 3e 20 74 69 6d 65 2d 61 20 74 .... (> time-a t
1ee0: 69 6d 65 2d 62 29 29 29 29 29 0a 3b 3b 20 09 09 ime-b))))).;; ..
1ef0: 20 20 20 20 20 20 20 3b 3b 20 74 65 73 74 2d 63 ;; test-c
1f00: 68 61 6e 67 65 73 20 69 73 20 61 20 6c 69 73 74 hanges is a list
1f10: 20 6f 66 20 28 28 20 69 64 20 72 65 63 6f 72 64 of (( id record
1f20: 20 29 20 2e 2e 2e 20 29 0a 3b 3b 20 09 09 20 20 ) ... ).;; ..
1f30: 20 20 20 20 20 3b 3b 20 47 65 74 20 6c 69 73 74 ;; Get list
1f40: 20 6f 66 20 74 65 73 74 20 6e 61 6d 65 73 20 73 of test names s
1f50: 6f 72 74 65 64 20 62 79 20 74 69 6d 65 2c 20 72 orted by time, r
1f60: 65 6d 6f 76 65 20 74 65 73 74 73 0a 3b 3b 20 09 emove tests.;; .
1f70: 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e 61 . (test-na
1f80: 6d 65 73 20 28 64 65 6c 65 74 65 2d 64 75 70 6c mes (delete-dupl
1f90: 69 63 61 74 65 73 20 28 6d 61 70 20 28 6c 61 6d icates (map (lam
1fa0: 62 64 61 20 28 74 29 0a 3b 3b 20 09 09 09 09 09 bda (t).;; .....
1fb0: 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 69 20 .. (let ((i
1fc0: 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d (db:mintest-get-
1fd0: 69 74 65 6d 5f 70 61 74 68 20 74 29 29 0a 3b 3b item_path t)).;;
1fe0: 20 09 09 09 09 09 09 09 09 20 20 20 28 6e 20 28 ........ (n (
1ff0: 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d 74 db:mintest-get-t
2000: 65 73 74 6e 61 6d 65 20 20 74 29 29 29 0a 3b 3b estname t))).;;
2010: 20 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ....... (
2020: 69 66 20 28 73 74 72 69 6e 67 3d 3f 20 69 20 22 if (string=? i "
2030: 22 29 0a 3b 3b 20 09 09 09 09 09 09 09 09 20 20 ").;; ........
2040: 20 28 63 6f 6e 63 20 22 20 20 20 22 20 69 29 0a (conc " " i).
2050: 3b 3b 20 09 09 09 09 09 09 09 09 20 20 20 6e 29 ;; ........ n)
2060: 29 29 0a 3b 3b 20 09 09 09 09 09 09 09 20 20 20 )).;; .......
2070: 74 65 73 74 73 29 29 29 0a 3b 3b 20 09 09 20 20 tests))).;; ..
2080: 20 20 20 20 20 28 63 6f 6c 6e 75 6d 20 20 20 20 (colnum
2090: 20 28 63 61 72 20 28 68 61 73 68 2d 74 61 62 6c (car (hash-tabl
20a0: 65 2d 72 65 66 20 72 75 6e 69 64 2d 74 6f 2d 63 e-ref runid-to-c
20b0: 6f 6c 20 72 75 6e 2d 69 64 29 29 29 29 0a 3b 3b ol run-id)))).;;
20c0: 20 09 09 20 20 3b 3b 20 66 6f 72 20 65 61 63 68 .. ;; for each
20d0: 20 74 65 73 74 20 6e 61 6d 65 20 67 65 74 20 74 test name get t
20e0: 68 65 20 73 6c 6f 74 20 69 66 20 69 74 20 65 78 he slot if it ex
20f0: 69 73 74 73 20 61 6e 64 20 66 69 6c 6c 20 69 6e ists and fill in
2100: 20 74 68 65 20 63 65 6c 6c 0a 3b 3b 20 09 09 20 the cell.;; ..
2110: 20 3b 3b 20 6f 72 20 74 61 6b 65 20 74 68 65 20 ;; or take the
2120: 6e 65 78 74 20 73 6c 6f 74 20 61 6e 64 20 66 69 next slot and fi
2130: 6c 6c 20 69 6e 20 74 68 65 20 63 65 6c 6c 2c 20 ll in the cell,
2140: 64 65 61 6c 20 77 69 74 68 20 69 74 65 6d 73 20 deal with items
2150: 69 6e 20 74 68 65 0a 3b 3b 20 09 09 20 20 3b 3b in the.;; .. ;;
2160: 20 72 75 6e 20 76 69 65 77 20 70 61 6e 65 6c 3f run view panel?
2170: 20 54 68 65 20 72 75 6e 20 76 69 65 77 20 70 61 The run view pa
2180: 6e 65 6c 20 63 61 6e 20 68 61 76 65 20 61 20 74 nel can have a t
2190: 72 65 65 20 73 65 6c 65 63 74 6f 72 20 66 6f 72 ree selector for
21a0: 0a 3b 3b 20 09 09 20 20 3b 3b 20 62 72 6f 77 73 .;; .. ;; brows
21b0: 69 6e 67 20 74 68 65 20 74 65 73 74 73 2f 69 74 ing the tests/it
21c0: 65 6d 73 0a 3b 3b 20 0a 3b 3b 20 09 09 20 20 3b ems.;; .;; .. ;
21d0: 3b 20 53 57 49 54 43 48 20 54 48 49 53 20 54 4f ; SWITCH THIS TO
21e0: 20 55 53 49 4e 47 20 43 48 41 4e 47 45 44 20 54 USING CHANGED T
21f0: 45 53 54 53 20 4f 4e 4c 59 0a 3b 3b 20 09 09 20 ESTS ONLY.;; ..
2200: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
2210: 64 61 20 28 74 65 73 74 29 0a 3b 3b 20 09 09 09 da (test).;; ...
2220: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 (let* ((te
2230: 73 74 2d 69 64 20 20 20 28 64 62 3a 6d 69 6e 74 st-id (db:mint
2240: 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 29 est-get-id test)
2250: 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 28 73 ).;; .... (s
2260: 74 61 74 65 20 20 20 20 20 28 64 62 3a 6d 69 6e tate (db:min
2270: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
2280: 65 73 74 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 est)).;; ....
2290: 20 20 28 73 74 61 74 75 73 20 20 20 20 28 64 62 (status (db
22a0: 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d 73 74 61 :mintest-get-sta
22b0: 74 75 73 20 74 65 73 74 29 29 0a 3b 3b 20 09 09 tus test)).;; ..
22c0: 09 09 20 20 20 20 20 28 74 65 73 74 6e 61 6d 65 .. (testname
22d0: 20 20 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 (db:mintest-ge
22e0: 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 29 t-testname test)
22f0: 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 28 69 ).;; .... (i
2300: 74 65 6d 70 61 74 68 20 20 28 64 62 3a 6d 69 6e tempath (db:min
2310: 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 5f 70 61 test-get-item_pa
2320: 74 68 20 74 65 73 74 29 29 0a 3b 3b 20 09 09 09 th test)).;; ...
2330: 09 20 20 20 20 20 28 66 75 6c 6c 6e 61 6d 65 20 . (fullname
2340: 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65 20 (conc testname
2350: 22 2f 22 20 69 74 65 6d 70 61 74 68 29 29 0a 3b "/" itempath)).;
2360: 3b 20 09 09 09 09 20 20 20 20 20 28 64 69 73 70 ; .... (disp
2370: 6e 61 6d 65 20 20 28 69 66 20 28 73 74 72 69 6e name (if (strin
2380: 67 3d 3f 20 69 74 65 6d 70 61 74 68 20 22 22 29 g=? itempath "")
2390: 20 74 65 73 74 6e 61 6d 65 20 28 63 6f 6e 63 20 testname (conc
23a0: 22 20 20 20 22 20 69 74 65 6d 70 61 74 68 29 29 " " itempath))
23b0: 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 28 72 ).;; .... (r
23c0: 6f 77 6e 75 6d 20 20 20 20 28 68 61 73 68 2d 74 ownum (hash-t
23d0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
23e0: 20 74 65 73 74 6e 61 6d 65 2d 74 6f 2d 72 6f 77 testname-to-row
23f0: 20 66 75 6c 6c 6e 61 6d 65 20 23 66 29 29 0a 3b fullname #f)).;
2400: 3b 20 09 09 09 09 20 20 20 20 20 28 74 65 73 74 ; .... (test
2410: 2d 70 61 74 68 20 28 61 70 70 65 6e 64 20 72 75 -path (append ru
2420: 6e 2d 70 61 74 68 20 28 69 66 20 28 65 71 75 61 n-path (if (equa
2430: 6c 3f 20 69 74 65 6d 70 61 74 68 20 22 22 29 20 l? itempath "")
2440: 0a 3b 3b 20 09 09 09 09 09 09 09 09 20 20 20 20 .;; ........
2450: 20 28 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 29 (list testname)
2460: 0a 3b 3b 20 09 09 09 09 09 09 09 09 20 20 20 20 .;; ........
2470: 20 28 6c 69 73 74 20 74 65 73 74 6e 61 6d 65 20 (list testname
2480: 69 74 65 6d 70 61 74 68 29 29 29 29 0a 3b 3b 20 itempath)))).;;
2490: 09 09 09 09 20 20 20 20 20 28 74 62 20 20 20 20 .... (tb
24a0: 20 20 20 20 20 28 64 62 6f 61 72 64 3a 74 61 62 (dboard:tab
24b0: 64 61 74 2d 74 65 73 74 73 2d 74 72 65 65 20 64 dat-tests-tree d
24c0: 61 74 61 29 29 29 0a 3b 3b 20 09 09 09 09 28 70 ata))).;; ....(p
24d0: 72 69 6e 74 20 22 49 4e 46 4f 4e 4f 54 45 3a 20 rint "INFONOTE:
24e0: 72 75 6e 2d 70 61 74 68 3a 20 22 20 72 75 6e 2d run-path: " run-
24f0: 70 61 74 68 29 0a 3b 3b 20 09 09 09 09 28 74 72 path).;; ....(tr
2500: 65 65 3a 61 64 64 2d 6e 6f 64 65 20 28 64 62 6f ee:add-node (dbo
2510: 61 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 73 ard:tabdat-tests
2520: 2d 74 72 65 65 20 64 61 74 61 29 20 22 52 75 6e -tree data) "Run
2530: 73 22 20 0a 3b 3b 20 09 09 09 09 09 20 20 20 20 s" .;; .....
2540: 20 20 20 74 65 73 74 2d 70 61 74 68 0a 3b 3b 20 test-path.;;
2550: 09 09 09 09 09 20 20 20 20 20 20 20 75 73 65 72 ..... user
2560: 64 61 74 61 3a 20 28 63 6f 6e 63 20 22 74 65 73 data: (conc "tes
2570: 74 2d 69 64 3a 20 22 20 74 65 73 74 2d 69 64 29 t-id: " test-id)
2580: 29 0a 3b 3b 20 09 09 09 09 28 6c 65 74 20 28 28 ).;; ....(let ((
2590: 6e 6f 64 65 2d 6e 75 6d 20 28 74 72 65 65 3a 66 node-num (tree:f
25a0: 69 6e 64 2d 6e 6f 64 65 20 74 62 20 28 63 6f 6e ind-node tb (con
25b0: 73 20 22 52 75 6e 73 22 20 74 65 73 74 2d 70 61 s "Runs" test-pa
25c0: 74 68 29 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 th))).;; ....
25d0: 20 20 20 28 63 6f 6c 6f 72 20 20 20 20 28 63 61 (color (ca
25e0: 72 20 28 67 75 74 69 6c 73 3a 67 65 74 2d 63 6f r (gutils:get-co
25f0: 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 lor-for-state-st
2600: 61 74 75 73 20 73 74 61 74 65 20 73 74 61 74 75 atus state statu
2610: 73 29 29 29 29 0a 3b 3b 20 09 09 09 09 20 20 28 s)))).;; .... (
2620: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
2630: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
2640: 20 22 6e 6f 64 65 2d 6e 75 6d 3a 20 22 20 6e 6f "node-num: " no
2650: 64 65 2d 6e 75 6d 20 22 2c 20 63 6f 6c 6f 72 3a de-num ", color:
2660: 20 22 20 63 6f 6c 6f 72 29 0a 3b 3b 20 0a 3b 3b " color).;; .;;
2670: 20 09 09 09 09 20 20 28 73 65 74 21 20 63 68 61 .... (set! cha
2680: 6e 67 65 64 20 28 64 63 6f 6d 6d 6f 6e 3a 6d 6f nged (dcommon:mo
2690: 64 69 66 69 79 2d 69 66 2d 64 69 66 66 65 72 65 difiy-if-differe
26a0: 6e 74 20 0a 3b 3b 20 09 09 09 09 09 09 20 74 62 nt .;; ...... tb
26b0: 0a 3b 3b 20 09 09 09 09 09 09 20 28 63 6f 6e 63 .;; ...... (conc
26c0: 20 22 43 4f 4c 4f 52 22 20 6e 6f 64 65 2d 6e 75 "COLOR" node-nu
26d0: 6d 29 0a 3b 3b 20 09 09 09 09 09 09 20 63 6f 6c m).;; ...... col
26e0: 6f 72 20 63 68 61 6e 67 65 64 29 29 0a 3b 3b 20 or changed)).;;
26f0: 0a 3b 3b 20 09 09 09 09 20 20 3b 3b 20 28 69 75 .;; .... ;; (iu
2700: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
2710: 20 74 62 20 28 63 6f 6e 63 20 22 43 4f 4c 4f 52 tb (conc "COLOR
2720: 22 20 6e 6f 64 65 2d 6e 75 6d 29 20 63 6f 6c 6f " node-num) colo
2730: 72 29 0a 3b 3b 20 09 09 09 09 20 20 29 0a 3b 3b r).;; .... ).;;
2740: 20 09 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 ....(hash-table
2750: 2d 73 65 74 21 20 28 64 62 6f 61 72 64 3a 74 61 -set! (dboard:ta
2760: 62 64 61 74 2d 70 61 74 68 2d 74 65 73 74 2d 69 bdat-path-test-i
2770: 64 73 20 64 61 74 61 29 20 74 65 73 74 2d 70 61 ds data) test-pa
2780: 74 68 20 74 65 73 74 2d 69 64 29 0a 3b 3b 20 09 th test-id).;; .
2790: 09 09 09 28 69 66 20 28 6e 6f 74 20 72 6f 77 6e ...(if (not rown
27a0: 75 6d 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 28 um).;; .... (
27b0: 6c 65 74 20 28 28 72 6f 77 6e 75 6d 73 20 28 68 let ((rownums (h
27c0: 61 73 68 2d 74 61 62 6c 65 2d 76 61 6c 75 65 73 ash-table-values
27d0: 20 74 65 73 74 6e 61 6d 65 2d 74 6f 2d 72 6f 77 testname-to-row
27e0: 29 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 ))).;; ....
27f0: 20 28 73 65 74 21 20 72 6f 77 6e 75 6d 20 28 69 (set! rownum (i
2800: 66 20 28 6e 75 6c 6c 3f 20 72 6f 77 6e 75 6d 73 f (null? rownums
2810: 29 0a 3b 3b 20 09 09 09 09 09 09 20 20 20 20 20 ).;; ......
2820: 20 20 31 0a 3b 3b 20 09 09 09 09 09 09 20 20 20 1.;; ......
2830: 20 20 20 20 28 2b 20 31 20 28 63 6f 6d 6d 6f 6e (+ 1 (common
2840: 3a 6d 61 78 20 72 6f 77 6e 75 6d 73 29 29 29 29 :max rownums))))
2850: 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 20 28 68 .;; .... (h
2860: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 ash-table-set! t
2870: 65 73 74 6e 61 6d 65 2d 74 6f 2d 72 6f 77 20 66 estname-to-row f
2880: 75 6c 6c 6e 61 6d 65 20 72 6f 77 6e 75 6d 29 0a ullname rownum).
2890: 3b 3b 20 09 09 09 09 20 20 20 20 20 20 3b 3b 20 ;; .... ;;
28a0: 63 72 65 61 74 65 20 74 68 65 20 6c 61 62 65 6c create the label
28b0: 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 20 28 73 .;; .... (s
28c0: 65 74 21 20 63 68 61 6e 67 65 64 20 28 64 63 6f et! changed (dco
28d0: 6d 6d 6f 6e 3a 6d 6f 64 69 66 69 79 2d 69 66 2d mmon:modifiy-if-
28e0: 64 69 66 66 65 72 65 6e 74 20 0a 3b 3b 20 09 09 different .;; ..
28f0: 09 09 09 09 20 20 20 20 20 28 64 62 6f 61 72 64 .... (dboard
2900: 3a 74 61 62 64 61 74 2d 72 75 6e 73 2d 6d 61 74 :tabdat-runs-mat
2910: 72 69 78 20 64 61 74 61 29 0a 3b 3b 20 09 09 09 rix data).;; ...
2920: 09 09 09 20 20 20 20 20 28 63 6f 6e 63 20 72 6f ... (conc ro
2930: 77 6e 75 6d 20 22 3a 22 20 30 29 0a 3b 3b 20 09 wnum ":" 0).;; .
2940: 09 09 09 09 09 20 20 20 20 20 64 69 73 70 6e 61 ..... dispna
2950: 6d 65 0a 3b 3b 20 09 09 09 09 09 09 20 20 20 20 me.;; ......
2960: 20 63 68 61 6e 67 65 64 29 29 0a 3b 3b 20 09 09 changed)).;; ..
2970: 09 09 20 20 20 20 20 20 3b 3b 20 28 69 75 70 3a .. ;; (iup:
2980: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 28 attribute-set! (
2990: 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 72 75 dboard:tabdat-ru
29a0: 6e 73 2d 6d 61 74 72 69 78 20 64 61 74 61 29 0a ns-matrix data).
29b0: 3b 3b 20 09 09 09 09 20 20 20 20 20 20 3b 3b 20 ;; .... ;;
29c0: 20 20 09 09 20 20 28 63 6f 6e 63 20 72 6f 77 6e .. (conc rown
29d0: 75 6d 20 22 3a 22 20 30 29 20 64 69 73 70 6e 61 um ":" 0) dispna
29e0: 6d 65 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 me).;; ....
29f0: 20 29 29 0a 3b 3b 20 09 09 09 09 3b 3b 20 73 65 )).;; ....;; se
2a00: 74 20 74 68 65 20 63 65 6c 6c 20 74 65 78 74 20 t the cell text
2a10: 61 6e 64 20 63 6f 6c 6f 72 0a 3b 3b 20 09 09 09 and color.;; ...
2a20: 09 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .;; (debug:print
2a30: 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 2 *default-log-
2a40: 70 6f 72 74 2a 20 22 72 6f 77 6e 75 6d 3a 63 6f port* "rownum:co
2a50: 6c 6e 75 6d 3d 22 20 72 6f 77 6e 75 6d 20 22 3a lnum=" rownum ":
2a60: 22 20 63 6f 6c 6e 75 6d 20 22 2c 20 73 74 61 74 " colnum ", stat
2a70: 65 3d 22 20 73 74 61 74 75 73 29 0a 3b 3b 20 09 e=" status).;; .
2a80: 09 09 09 28 73 65 74 21 20 63 68 61 6e 67 65 64 ...(set! changed
2a90: 20 28 64 63 6f 6d 6d 6f 6e 3a 6d 6f 64 69 66 69 (dcommon:modifi
2aa0: 79 2d 69 66 2d 64 69 66 66 65 72 65 6e 74 20 0a y-if-different .
2ab0: 3b 3b 20 09 09 09 09 09 09 20 20 20 20 20 28 64 ;; ...... (d
2ac0: 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 72 75 6e board:tabdat-run
2ad0: 73 2d 6d 61 74 72 69 78 20 64 61 74 61 29 0a 3b s-matrix data).;
2ae0: 3b 20 09 09 09 09 09 09 20 20 20 20 20 28 63 6f ; ...... (co
2af0: 6e 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f nc rownum ":" co
2b00: 6c 6e 75 6d 29 0a 3b 3b 20 09 09 09 09 09 09 20 lnum).;; ......
2b10: 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 (if (member
2b20: 73 74 61 74 65 20 27 28 22 41 52 43 48 49 56 45 state '("ARCHIVE
2b30: 44 22 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 D" "COMPLETED"))
2b40: 0a 3b 3b 20 09 09 09 09 09 09 09 20 73 74 61 74 .;; ....... stat
2b50: 75 73 0a 3b 3b 20 09 09 09 09 09 09 09 20 73 74 us.;; ....... st
2b60: 61 74 65 29 0a 3b 3b 20 09 09 09 09 09 09 20 20 ate).;; ......
2b70: 20 20 20 63 68 61 6e 67 65 64 29 29 0a 3b 3b 20 changed)).;;
2b80: 09 09 09 09 3b 3b 20 28 69 75 70 3a 61 74 74 72 ....;; (iup:attr
2b90: 69 62 75 74 65 2d 73 65 74 21 20 28 64 62 6f 61 ibute-set! (dboa
2ba0: 72 64 3a 74 61 62 64 61 74 2d 72 75 6e 73 2d 6d rd:tabdat-runs-m
2bb0: 61 74 72 69 78 20 64 61 74 61 29 0a 3b 3b 20 09 atrix data).;; .
2bc0: 09 09 09 3b 3b 20 09 09 20 20 20 20 28 63 6f 6e ...;; .. (con
2bd0: 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c c rownum ":" col
2be0: 6e 75 6d 29 0a 3b 3b 20 09 09 09 09 3b 3b 20 09 num).;; ....;; .
2bf0: 09 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 . (if (member
2c00: 20 73 74 61 74 65 20 27 28 22 41 52 43 48 49 56 state '("ARCHIV
2c10: 45 44 22 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 ED" "COMPLETED")
2c20: 29 0a 3b 3b 20 09 09 09 09 3b 3b 20 09 09 09 73 ).;; ....;; ...s
2c30: 74 61 74 75 73 0a 3b 3b 20 09 09 09 09 3b 3b 20 tatus.;; ....;;
2c40: 09 09 09 73 74 61 74 65 29 29 0a 3b 3b 20 09 09 ...state)).;; ..
2c50: 09 09 28 73 65 74 21 20 63 68 61 6e 67 65 64 20 ..(set! changed
2c60: 28 64 63 6f 6d 6d 6f 6e 3a 6d 6f 64 69 66 69 79 (dcommon:modifiy
2c70: 2d 69 66 2d 64 69 66 66 65 72 65 6e 74 20 0a 3b -if-different .;
2c80: 3b 20 09 09 09 09 09 20 20 20 20 20 20 20 28 64 ; ..... (d
2c90: 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 72 75 6e board:tabdat-run
2ca0: 73 2d 6d 61 74 72 69 78 20 64 61 74 61 29 0a 3b s-matrix data).;
2cb0: 3b 20 09 09 09 09 09 20 20 20 20 20 20 20 28 63 ; ..... (c
2cc0: 6f 6e 63 20 22 42 47 43 4f 4c 4f 52 22 20 72 6f onc "BGCOLOR" ro
2cd0: 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 wnum ":" colnum)
2ce0: 0a 3b 3b 20 09 09 09 09 09 20 20 20 20 20 20 20 .;; .....
2cf0: 28 63 61 72 20 28 67 75 74 69 6c 73 3a 67 65 74 (car (gutils:get
2d00: 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 -color-for-state
2d10: 2d 73 74 61 74 75 73 20 73 74 61 74 65 20 73 74 -status state st
2d20: 61 74 75 73 29 29 0a 3b 3b 20 09 09 09 09 09 20 atus)).;; .....
2d30: 20 20 20 20 20 20 63 68 61 6e 67 65 64 29 29 0a changed)).
2d40: 3b 3b 20 09 09 09 09 3b 3b 20 28 69 75 70 3a 61 ;; ....;; (iup:a
2d50: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 28 64 ttribute-set! (d
2d60: 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 72 75 6e board:tabdat-run
2d70: 73 2d 6d 61 74 72 69 78 20 64 61 74 61 29 0a 3b s-matrix data).;
2d80: 3b 20 09 09 09 09 3b 3b 20 09 09 20 20 20 20 28 ; ....;; .. (
2d90: 63 6f 6e 63 20 22 42 47 43 4f 4c 4f 52 22 20 72 conc "BGCOLOR" r
2da0: 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d ownum ":" colnum
2db0: 29 0a 3b 3b 20 09 09 09 09 3b 3b 20 09 09 20 20 ).;; ....;; ..
2dc0: 20 20 28 63 61 72 20 28 67 75 74 69 6c 73 3a 67 (car (gutils:g
2dd0: 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 et-color-for-sta
2de0: 74 65 2d 73 74 61 74 75 73 20 73 74 61 74 65 20 te-status state
2df0: 73 74 61 74 75 73 29 29 29 0a 3b 3b 20 09 09 09 status))).;; ...
2e00: 09 29 29 0a 3b 3b 20 09 09 09 20 20 20 20 74 65 .)).;; ... te
2e10: 73 74 73 29 29 29 0a 3b 3b 20 09 20 20 20 20 20 sts))).;; .
2e20: 20 72 75 6e 2d 69 64 73 29 0a 3b 3b 20 0a 3b 3b run-ids).;; .;;
2e30: 20 20 20 20 20 28 6c 65 74 20 28 28 75 70 64 61 (let ((upda
2e40: 74 65 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ter (hash-table-
2e50: 72 65 66 2f 64 65 66 61 75 6c 74 20 20 28 64 62 ref/default (db
2e60: 6f 61 72 64 3a 63 6f 6d 6d 6f 6e 64 61 74 2d 75 oard:commondat-u
2e70: 70 64 61 74 65 72 73 20 63 6f 6d 6d 6f 6e 64 61 pdaters commonda
2e80: 74 29 20 77 69 6e 64 6f 77 2d 69 64 20 23 66 29 t) window-id #f)
2e90: 29 29 0a 3b 3b 20 20 20 20 20 20 20 28 69 66 20 )).;; (if
2ea0: 75 70 64 61 74 65 72 20 28 75 70 64 61 74 65 72 updater (updater
2eb0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
2ec0: 2f 64 65 66 61 75 6c 74 20 64 61 74 61 20 67 65 /default data ge
2ed0: 74 2d 64 65 74 61 69 6c 73 2d 73 69 67 20 23 66 t-details-sig #f
2ee0: 29 29 29 29 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 )))).;; .;;
2ef0: 28 69 66 20 63 68 61 6e 67 65 64 20 28 69 75 70 (if changed (iup
2f00: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
2f10: 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 72 (dboard:tabdat-r
2f20: 75 6e 73 2d 6d 61 74 72 69 78 20 64 61 74 61 29 uns-matrix data)
2f30: 20 22 52 45 44 52 41 57 22 20 22 41 4c 4c 22 29 "REDRAW" "ALL")
2f40: 29 0a 3b 3b 20 20 20 20 20 3b 3b 20 28 64 65 62 ).;; ;; (deb
2f50: 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 ug:print 2 *defa
2f60: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 ult-log-port* "r
2f70: 75 6e 2d 63 68 61 6e 67 65 73 3a 20 22 20 72 75 un-changes: " ru
2f80: 6e 2d 63 68 61 6e 67 65 73 29 0a 3b 3b 20 20 20 n-changes).;;
2f90: 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e ;; (debug:prin
2fa0: 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 2 *default-log
2fb0: 2d 70 6f 72 74 2a 20 22 74 65 73 74 2d 63 68 61 -port* "test-cha
2fc0: 6e 67 65 73 3a 20 22 20 74 65 73 74 2d 63 68 61 nges: " test-cha
2fd0: 6e 67 65 73 29 0a 3b 3b 20 20 20 20 20 28 6c 69 nges).;; (li
2fe0: 73 74 20 72 75 6e 2d 63 68 61 6e 67 65 73 20 61 st run-changes a
2ff0: 6c 6c 2d 74 65 73 74 2d 63 68 61 6e 67 65 73 29 ll-test-changes)
3000: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 6f ))..(define (dco
3010: 6d 6d 6f 6e 3a 72 75 6e 73 64 61 74 2d 67 65 74 mmon:runsdat-get
3020: 2d 63 6f 6c 2d 6e 75 6d 20 64 61 74 20 74 61 72 -col-num dat tar
3030: 67 65 74 20 72 75 6e 6e 61 6d 65 20 66 6f 72 63 get runname forc
3040: 65 2d 73 65 74 29 0a 20 20 28 6c 65 74 2a 20 28 e-set). (let* (
3050: 28 72 75 6e 73 2d 69 6e 64 65 78 20 28 64 62 6f (runs-index (dbo
3060: 61 72 64 3a 72 75 6e 73 64 61 74 2d 72 75 6e 73 ard:runsdat-runs
3070: 2d 69 6e 64 65 78 20 64 61 74 29 29 0a 09 20 28 -index dat)).. (
3080: 63 6f 6c 2d 6e 61 6d 65 20 20 20 28 63 6f 6e 63 col-name (conc
3090: 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e target "/" runn
30a0: 61 6d 65 29 29 0a 09 20 28 72 65 73 20 20 20 20 ame)).. (res
30b0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
30c0: 72 65 66 2f 64 65 66 61 75 6c 74 20 72 75 6e 73 ref/default runs
30d0: 2d 69 6e 64 65 78 20 63 6f 6c 2d 6e 61 6d 65 20 -index col-name
30e0: 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 72 65 #f))). (if re
30f0: 73 0a 09 72 65 73 0a 09 28 69 66 20 66 6f 72 63 s..res..(if forc
3100: 65 2d 73 65 74 0a 09 20 20 20 20 28 6c 65 74 20 e-set.. (let
3110: 28 28 6d 61 78 2d 63 6f 6c 2d 6e 75 6d 20 28 2b ((max-col-num (+
3120: 20 31 20 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 20 28 1 (common:max (
3130: 63 6f 6e 73 2d 31 20 28 68 61 73 68 2d 74 61 62 cons-1 (hash-tab
3140: 6c 65 2d 76 61 6c 75 65 73 20 72 75 6e 73 2d 69 le-values runs-i
3150: 6e 64 65 78 29 29 29 29 29 29 0a 09 20 20 20 20 ndex))))))..
3160: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
3170: 74 21 20 72 75 6e 73 2d 69 6e 64 65 78 20 63 6f t! runs-index co
3180: 6c 2d 6e 61 6d 65 20 6d 61 78 2d 63 6f 6c 2d 6e l-name max-col-n
3190: 75 6d 29 0a 09 20 20 20 20 20 20 6d 61 78 2d 63 um).. max-c
31a0: 6f 6c 2d 6e 75 6d 29 29 29 29 29 0a 0a 28 64 65 ol-num)))))..(de
31b0: 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 72 75 fine (dcommon:ru
31c0: 6e 73 64 61 74 2d 67 65 74 2d 72 6f 77 2d 6e 75 nsdat-get-row-nu
31d0: 6d 20 64 61 74 20 74 65 73 74 6e 61 6d 65 20 69 m dat testname i
31e0: 74 65 6d 70 61 74 68 20 66 6f 72 63 65 2d 73 65 tempath force-se
31f0: 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 t). (let* ((tes
3200: 74 73 2d 69 6e 64 65 78 20 28 64 62 6f 61 72 64 ts-index (dboard
3210: 3a 72 75 6e 73 64 61 74 2d 72 75 6e 73 2d 69 6e :runsdat-runs-in
3220: 64 65 78 20 64 61 74 29 29 0a 09 20 28 72 6f 77 dex dat)).. (row
3230: 2d 6e 61 6d 65 20 20 20 20 28 63 6f 6e 63 20 74 -name (conc t
3240: 65 73 74 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d estname "/" item
3250: 70 61 74 68 29 29 0a 09 20 28 72 65 73 20 20 20 path)).. (res
3260: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
3270: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 75 e-ref/default ru
3280: 6e 73 2d 69 6e 64 65 78 20 72 6f 77 2d 6e 61 6d ns-index row-nam
3290: 65 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 e #f))). (if
32a0: 72 65 73 0a 09 72 65 73 0a 09 28 69 66 20 66 6f res..res..(if fo
32b0: 72 63 65 2d 73 65 74 0a 09 20 20 20 20 28 6c 65 rce-set.. (le
32c0: 74 20 28 28 6d 61 78 2d 72 6f 77 2d 6e 75 6d 20 t ((max-row-num
32d0: 28 2b 20 31 20 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 (+ 1 (common:max
32e0: 20 28 63 6f 6e 73 20 2d 31 20 28 68 61 73 68 2d (cons -1 (hash-
32f0: 74 61 62 6c 65 2d 76 61 6c 75 65 73 20 74 65 73 table-values tes
3300: 74 73 2d 69 6e 64 65 78 29 29 29 29 29 29 0a 09 ts-index))))))..
3310: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
3320: 65 2d 73 65 74 21 20 72 75 6e 73 2d 69 6e 64 65 e-set! runs-inde
3330: 78 20 72 6f 77 2d 6e 61 6d 65 20 6d 61 78 2d 72 x row-name max-r
3340: 6f 77 2d 6e 75 6d 29 0a 09 20 20 20 20 20 20 6d ow-num).. m
3350: 61 78 2d 72 6f 77 2d 6e 75 6d 29 29 29 29 29 0a ax-row-num))))).
3360: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f .(define (dcommo
3370: 6e 3a 72 75 6e 64 61 74 2d 63 6f 70 79 2d 74 65 n:rundat-copy-te
3380: 73 74 73 2d 74 6f 2d 62 79 2d 6e 61 6d 65 20 72 sts-to-by-name r
3390: 75 6e 64 61 74 29 0a 20 20 28 6c 65 74 20 28 28 undat). (let ((
33a0: 73 72 63 2d 68 74 20 28 64 62 6f 61 72 64 3a 72 src-ht (dboard:r
33b0: 75 6e 64 61 74 2d 74 65 73 74 73 20 72 75 6e 64 undat-tests rund
33c0: 61 74 29 29 0a 09 28 74 72 67 2d 68 74 20 28 64 at))..(trg-ht (d
33d0: 62 6f 61 72 64 3a 72 75 6e 64 61 74 2d 74 65 73 board:rundat-tes
33e0: 74 73 2d 62 79 2d 6e 61 6d 65 20 72 75 6e 64 61 ts-by-name runda
33f0: 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 6e t))). (if (an
3400: 64 20 28 68 61 73 68 2d 74 61 62 6c 65 3f 20 73 d (hash-table? s
3410: 72 63 2d 68 74 29 28 68 61 73 68 2d 74 61 62 6c rc-ht)(hash-tabl
3420: 65 3f 20 74 72 67 2d 68 74 29 29 0a 09 28 62 65 e? trg-ht))..(be
3430: 67 69 6e 0a 09 20 20 28 68 61 73 68 2d 74 61 62 gin.. (hash-tab
3440: 6c 65 2d 63 6c 65 61 72 21 20 74 72 67 2d 68 74 le-clear! trg-ht
3450: 29 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 ).. (for-each..
3460: 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 (lambda (test
3470: 64 61 74 29 0a 09 20 20 20 20 20 28 68 61 73 68 dat).. (hash
3480: 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 72 67 2d -table-set! trg-
3490: 68 74 20 28 74 65 73 74 3a 74 65 73 74 2d 67 65 ht (test:test-ge
34a0: 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 t-fullname testd
34b0: 61 74 29 20 74 65 73 74 64 61 74 29 29 0a 09 20 at) testdat))..
34c0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 76 61 (hash-table-va
34d0: 6c 75 65 73 20 73 72 63 2d 68 74 29 29 29 0a 09 lues src-ht)))..
34e0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
34f0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
3500: 2a 20 22 57 41 52 4e 49 4e 47 3a 20 73 72 63 2d * "WARNING: src-
3510: 68 74 20 22 20 73 72 63 2d 68 74 20 22 20 74 72 ht " src-ht " tr
3520: 67 2d 68 74 20 22 20 74 72 67 2d 68 74 29 29 29 g-ht " trg-ht)))
3530: 29 0a 20 20 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ). ..;;========
3540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
3580: 3b 20 54 45 53 54 53 20 44 41 54 41 0a 3b 3b 3d ; TESTS DATA.;;=
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 3d 3d 3d ================
35c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35d0: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 50 72 6f 64 75 63 =====..;; Produc
35e0: 65 20 61 20 6c 69 73 74 20 6f 66 20 6c 69 73 74 e a list of list
35f0: 73 20 72 65 61 64 79 20 66 6f 72 20 63 6f 6d 6d s ready for comm
3600: 6f 6e 3a 73 70 61 72 73 65 2d 6c 69 73 74 2d 67 on:sparse-list-g
3610: 65 6e 65 72 61 74 65 2d 69 6e 64 65 78 0a 3b 3b enerate-index.;;
3620: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f .(define (dcommo
3630: 6e 3a 6d 69 6e 69 6d 69 7a 65 2d 74 65 73 74 2d n:minimize-test-
3640: 64 61 74 61 20 74 65 73 74 73 2d 64 61 74 29 0a data tests-dat).
3650: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 65 73 (if (null? tes
3660: 74 73 2d 64 61 74 29 20 0a 20 20 20 20 20 20 27 ts-dat) . '
3670: 28 29 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f (). (let lo
3680: 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 74 65 op ((hed (car te
3690: 73 74 73 2d 64 61 74 29 29 0a 09 09 20 28 74 61 sts-dat))... (ta
36a0: 6c 20 28 63 64 72 20 74 65 73 74 73 2d 64 61 74 l (cdr tests-dat
36b0: 29 29 0a 09 09 20 28 72 65 73 20 27 28 29 29 29 ))... (res '()))
36c0: 0a 09 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 ..(let* ((test-i
36d0: 64 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 d (db:test-ge
36e0: 74 2d 69 64 20 68 65 64 29 29 20 3b 3b 20 6c 6f t-id hed)) ;; lo
36f0: 6f 6b 20 61 74 20 74 68 65 20 74 65 73 74 73 2d ok at the tests-
3700: 64 61 74 20 73 70 65 63 20 66 6f 72 20 6c 6f 63 dat spec for loc
3710: 61 74 69 6f 6e 73 0a 09 20 20 20 20 20 20 20 28 ations.. (
3720: 74 65 73 74 2d 6e 61 6d 65 20 20 28 64 62 3a 74 test-name (db:t
3730: 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 est-get-testname
3740: 20 68 65 64 29 29 0a 09 20 20 20 20 20 20 20 28 hed)).. (
3750: 69 74 65 6d 2d 70 61 74 68 20 20 28 64 62 3a 74 item-path (db:t
3760: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
3770: 68 20 68 65 64 29 29 0a 09 20 20 20 20 20 20 20 h hed))..
3780: 28 73 74 61 74 65 20 20 20 20 20 20 28 64 62 3a (state (db:
3790: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 68 test-get-state h
37a0: 65 64 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 ed)).. (st
37b0: 61 74 75 73 20 20 20 20 20 28 64 62 3a 74 65 73 atus (db:tes
37c0: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 68 65 64 t-get-status hed
37d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
37e0: 20 20 28 65 76 65 6e 74 2d 74 69 6d 65 20 28 64 (event-time (d
37f0: 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 b:test-get-event
3800: 5f 74 69 6d 65 20 68 65 64 29 29 0a 09 20 20 20 _time hed))..
3810: 20 20 20 20 28 6e 65 77 69 74 65 6d 20 20 20 20 (newitem
3820: 28 6c 69 73 74 20 74 65 73 74 2d 6e 61 6d 65 20 (list test-name
3830: 69 74 65 6d 2d 70 61 74 68 20 28 6c 69 73 74 20 item-path (list
3840: 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 73 74 test-id state st
3850: 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 29 atus event-time)
3860: 29 29 29 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c ))).. (if (null
3870: 3f 20 74 61 6c 29 0a 09 20 20 20 20 20 20 28 72 ? tal).. (r
3880: 65 76 65 72 73 65 20 28 63 6f 6e 73 20 6e 65 77 everse (cons new
3890: 69 74 65 6d 20 72 65 73 29 29 0a 09 20 20 20 20 item res))..
38a0: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
38b0: 29 28 63 64 72 20 74 61 6c 29 28 63 6f 6e 73 20 )(cdr tal)(cons
38c0: 6e 65 77 69 74 65 6d 20 72 65 73 29 29 29 29 29 newitem res)))))
38d0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 6f ))..(define (dco
38e0: 6d 6d 6f 6e 3a 74 65 73 74 73 2d 6d 69 6e 64 61 mmon:tests-minda
38f0: 74 2d 3e 68 61 73 68 20 74 65 73 74 73 2d 6d 69 t->hash tests-mi
3900: 6e 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 ndat). (let* ((
3910: 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 res (make-hash-t
3920: 61 62 6c 65 29 29 29 0a 20 20 20 20 28 66 6f 72 able))). (for
3930: 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 -each. (lamb
3940: 64 61 20 28 69 74 65 6d 29 0a 20 20 20 20 20 20 da (item).
3950: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 6e 61 (let* ((test-na
3960: 6d 65 2b 69 74 65 6d 2d 70 61 74 68 20 28 63 6f me+item-path (co
3970: 6e 73 20 28 6c 69 73 74 2d 72 65 66 20 69 74 65 ns (list-ref ite
3980: 6d 20 30 29 20 28 6c 69 73 74 2d 72 65 66 20 69 m 0) (list-ref i
3990: 74 65 6d 20 31 29 29 29 0a 20 20 20 20 20 20 20 tem 1))).
39a0: 20 20 20 20 20 20 20 28 76 61 6c 75 65 20 28 6c (value (l
39b0: 69 73 74 2d 72 65 66 20 69 74 65 6d 20 32 29 29 ist-ref item 2))
39c0: 29 0a 20 20 20 20 20 20 20 20 20 28 68 61 73 68 ). (hash
39d0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 -table-set! res
39e0: 74 65 73 74 2d 6e 61 6d 65 2b 69 74 65 6d 2d 70 test-name+item-p
39f0: 61 74 68 20 76 61 6c 75 65 29 29 29 0a 20 20 20 ath value))).
3a00: 20 20 74 65 73 74 73 2d 6d 69 6e 64 61 74 29 0a tests-mindat).
3a10: 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 72 65 res))..;; re
3a20: 74 75 72 6e 20 31 20 69 66 20 73 74 61 74 75 73 turn 1 if status
3a30: 31 20 69 73 20 62 65 74 74 65 72 0a 3b 3b 20 72 1 is better.;; r
3a40: 65 74 75 72 6e 20 30 20 69 66 20 73 74 61 74 75 eturn 0 if statu
3a50: 73 31 20 61 6e 64 20 32 20 61 72 65 20 65 71 75 s1 and 2 are equ
3a60: 61 6c 6c 79 20 67 6f 6f 64 0a 3b 3b 20 72 65 74 ally good.;; ret
3a70: 75 72 6e 20 2d 31 20 69 66 20 73 74 61 74 75 73 urn -1 if status
3a80: 32 20 69 73 20 62 65 74 74 65 72 0a 28 64 65 66 2 is better.(def
3a90: 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 73 74 61 ine (dcommon:sta
3aa0: 74 75 73 2d 63 6f 6d 70 61 72 65 33 20 73 74 61 tus-compare3 sta
3ab0: 74 75 73 31 20 73 74 61 74 75 73 32 29 0a 20 20 tus1 status2).
3ac0: 28 6c 65 74 2a 0a 20 20 20 20 20 20 28 28 73 74 (let*. ((st
3ad0: 61 74 75 73 2d 67 6f 6f 64 6e 65 73 73 2d 72 61 atus-goodness-ra
3ae0: 6e 6b 69 6e 67 20 20 28 63 64 72 20 3b 3b 20 63 nking (cdr ;; c
3af0: 64 72 20 74 6f 20 64 72 6f 70 20 66 69 72 73 74 dr to drop first
3b00: 20 69 74 65 6d 20 2d 2d 20 22 6e 2f 61 22 0a 20 item -- "n/a".
3b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b30: 20 28 61 70 70 65 6e 64 20 28 6d 61 70 20 63 61 (append (map ca
3b40: 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 64 2d 73 dr *common:std-s
3b50: 74 61 74 75 73 65 73 2a 29 0a 20 20 20 20 20 20 tatuses*).
3b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b80: 20 20 20 20 27 28 23 66 29 29 20 3b 3b 20 61 6c '(#f)) ;; al
3b90: 67 6f 72 69 74 68 6d 20 72 65 71 75 72 65 73 20 gorithm requres
3ba0: 6c 61 73 74 20 69 74 65 6d 20 74 6f 20 62 65 20 last item to be
3bb0: 23 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 #f.
3bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3bd0: 20 20 20 20 20 29 20 20 29 0a 20 20 20 20 20 20 ) ).
3be0: 20 28 6d 65 6d 31 20 28 6d 65 6d 62 65 72 20 73 (mem1 (member s
3bf0: 74 61 74 75 73 31 20 73 74 61 74 75 73 2d 67 6f tatus1 status-go
3c00: 6f 64 6e 65 73 73 2d 72 61 6e 6b 69 6e 67 29 29 odness-ranking))
3c10: 0a 20 20 20 20 20 20 20 28 6d 65 6d 32 20 28 6d . (mem2 (m
3c20: 65 6d 62 65 72 20 73 74 61 74 75 73 32 20 73 74 ember status2 st
3c30: 61 74 75 73 2d 67 6f 6f 64 6e 65 73 73 2d 72 61 atus-goodness-ra
3c40: 6e 6b 69 6e 67 29 29 0a 20 20 20 20 20 20 20 29 nking)). )
3c50: 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 . (cond.
3c60: 28 28 61 6e 64 20 28 6e 6f 74 20 6d 65 6d 31 29 ((and (not mem1)
3c70: 20 28 6e 6f 74 20 6d 65 6d 32 29 29 20 30 29 0a (not mem2)) 0).
3c80: 20 20 20 20 20 28 28 6e 6f 74 20 6d 65 6d 31 29 ((not mem1)
3c90: 20 2d 31 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 -1). ((not
3ca0: 6d 65 6d 32 29 20 31 29 0a 20 20 20 20 20 28 28 mem2) 1). ((
3cb0: 3d 20 28 6c 65 6e 67 74 68 20 6d 65 6d 31 29 20 = (length mem1)
3cc0: 28 6c 65 6e 67 74 68 20 6d 65 6d 32 29 29 20 30 (length mem2)) 0
3cd0: 29 0a 20 20 20 20 20 28 28 3e 20 28 6c 65 6e 67 ). ((> (leng
3ce0: 74 68 20 6d 65 6d 31 29 20 28 6c 65 6e 67 74 68 th mem1) (length
3cf0: 20 6d 65 6d 32 29 29 20 31 29 0a 20 20 20 20 20 mem2)) 1).
3d00: 28 65 6c 73 65 20 2d 31 29 29 29 29 0a 20 20 20 (else -1)))).
3d10: 20 20 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d .(define (dcom
3d20: 6d 6f 6e 3a 78 6f 72 2d 74 65 73 74 73 2d 6d 69 mon:xor-tests-mi
3d30: 6e 64 61 74 20 73 72 63 2d 74 65 73 74 73 2d 6d ndat src-tests-m
3d40: 69 6e 64 61 74 20 64 65 73 74 2d 74 65 73 74 73 indat dest-tests
3d50: 2d 6d 69 6e 64 61 74 20 23 21 6b 65 79 20 28 68 -mindat #!key (h
3d60: 69 64 65 2d 63 6c 65 61 6e 20 23 66 29 29 0a 20 ide-clean #f)).
3d70: 20 28 6c 65 74 2a 20 28 28 73 72 63 2d 68 61 73 (let* ((src-has
3d80: 68 20 28 64 63 6f 6d 6d 6f 6e 3a 74 65 73 74 73 h (dcommon:tests
3d90: 2d 6d 69 6e 64 61 74 2d 3e 68 61 73 68 20 73 72 -mindat->hash sr
3da0: 63 2d 74 65 73 74 73 2d 6d 69 6e 64 61 74 29 29 c-tests-mindat))
3db0: 0a 20 20 20 20 20 20 20 20 20 28 64 65 73 74 2d . (dest-
3dc0: 68 61 73 68 20 28 64 63 6f 6d 6d 6f 6e 3a 74 65 hash (dcommon:te
3dd0: 73 74 73 2d 6d 69 6e 64 61 74 2d 3e 68 61 73 68 sts-mindat->hash
3de0: 20 64 65 73 74 2d 74 65 73 74 73 2d 6d 69 6e 64 dest-tests-mind
3df0: 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 28 61 at)). (a
3e00: 6c 6c 2d 6b 65 79 73 0a 20 20 20 20 20 20 20 20 ll-keys.
3e10: 20 20 28 72 65 76 65 72 73 65 20 28 73 6f 72 74 (reverse (sort
3e20: 20 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 65 . (de
3e30: 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 0a lete-duplicates.
3e40: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
3e50: 65 6e 64 20 28 68 61 73 68 2d 74 61 62 6c 65 2d end (hash-table-
3e60: 6b 65 79 73 20 73 72 63 2d 68 61 73 68 29 20 28 keys src-hash) (
3e70: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys
3e80: 64 65 73 74 2d 68 61 73 68 29 29 29 0a 0a 20 20 dest-hash)))..
3e90: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
3ea0: 20 28 61 20 62 29 20 0a 20 20 20 20 20 20 20 20 (a b) .
3eb0: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
3ec0: 20 20 20 20 20 20 20 20 20 28 28 3c 20 30 20 28 ((< 0 (
3ed0: 73 74 72 69 6e 67 2d 63 6f 6d 70 61 72 65 33 20 string-compare3
3ee0: 28 63 61 72 20 61 29 20 28 63 61 72 20 62 29 29 (car a) (car b))
3ef0: 29 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 20 ) #t).
3f00: 20 20 20 20 28 28 3e 20 30 20 28 73 74 72 69 6e ((> 0 (strin
3f10: 67 2d 63 6f 6d 70 61 72 65 33 20 28 63 61 72 20 g-compare3 (car
3f20: 61 29 20 28 63 61 72 20 62 29 29 29 20 23 66 29 a) (car b))) #f)
3f30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
3f40: 28 3c 20 30 20 28 73 74 72 69 6e 67 2d 63 6f 6d (< 0 (string-com
3f50: 70 61 72 65 33 20 28 63 64 72 20 61 29 20 28 63 pare3 (cdr a) (c
3f60: 64 72 20 62 29 29 29 20 23 74 29 0a 20 20 20 20 dr b))) #t).
3f70: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
3f80: 23 66 29 29 29 0a 0a 20 20 20 20 20 20 20 20 20 #f)))..
3f90: 20 20 29 29 29 29 0a 20 20 20 20 28 6c 65 74 20 )))). (let
3fa0: 28 28 72 65 73 0a 20 20 20 20 20 20 20 20 20 20 ((res.
3fb0: 20 28 6d 61 70 20 3b 3b 20 54 4f 44 4f 3a 20 72 (map ;; TODO: r
3fc0: 65 6e 61 6d 65 20 78 6f 72 20 74 6f 20 64 65 6c ename xor to del
3fd0: 74 61 20 67 6c 6f 62 61 6c 6c 79 20 69 6e 20 64 ta globally in d
3fe0: 63 6f 6d 6d 6f 6e 20 61 6e 64 20 64 61 73 68 62 common and dashb
3ff0: 6f 61 72 64 0a 20 20 20 20 20 20 20 20 20 20 20 oard.
4000: 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 20 (lambda (key).
4010: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
4020: 74 2a 20 28 28 74 65 73 74 2d 6e 61 6d 65 20 28 t* ((test-name (
4030: 63 61 72 20 6b 65 79 29 29 0a 20 20 20 20 20 20 car key)).
4040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4050: 69 74 65 6d 2d 70 61 74 68 20 28 63 64 72 20 6b item-path (cdr k
4060: 65 79 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 ey))..
4070: 20 20 20 20 20 20 20 20 20 20 20 28 64 65 73 74 (dest
4080: 2d 76 61 6c 75 65 20 28 68 61 73 68 2d 74 61 62 -value (hash-tab
4090: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 64 le-ref/default d
40a0: 65 73 74 2d 68 61 73 68 20 6b 65 79 20 23 66 29 est-hash key #f)
40b0: 29 20 3b 3b 20 28 6c 69 73 74 20 74 65 73 74 2d ) ;; (list test-
40c0: 69 64 20 73 74 61 74 65 20 73 74 61 74 75 73 29 id state status)
40d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
40e0: 20 20 20 20 20 20 28 64 65 73 74 2d 74 65 73 74 (dest-test
40f0: 2d 69 64 20 20 28 69 66 20 64 65 73 74 2d 76 61 -id (if dest-va
4100: 6c 75 65 20 28 6c 69 73 74 2d 72 65 66 20 64 65 lue (list-ref de
4110: 73 74 2d 76 61 6c 75 65 20 30 29 20 23 66 29 29 st-value 0) #f))
4120: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4130: 20 20 20 20 20 20 28 64 65 73 74 2d 73 74 61 74 (dest-stat
4140: 65 20 20 20 20 28 69 66 20 64 65 73 74 2d 76 61 e (if dest-va
4150: 6c 75 65 20 28 6c 69 73 74 2d 72 65 66 20 64 65 lue (list-ref de
4160: 73 74 2d 76 61 6c 75 65 20 31 29 20 23 66 29 29 st-value 1) #f))
4170: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4180: 20 20 20 20 20 20 28 64 65 73 74 2d 73 74 61 74 (dest-stat
4190: 75 73 20 20 20 28 69 66 20 64 65 73 74 2d 76 61 us (if dest-va
41a0: 6c 75 65 20 28 6c 69 73 74 2d 72 65 66 20 64 65 lue (list-ref de
41b0: 73 74 2d 76 61 6c 75 65 20 32 29 20 23 66 29 29 st-value 2) #f))
41c0: 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
41d0: 20 20 20 20 20 20 20 28 73 72 63 2d 76 61 6c 75 (src-valu
41e0: 65 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c e (hash-tabl
41f0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 73 72 e-ref/default sr
4200: 63 2d 68 61 73 68 20 6b 65 79 20 23 66 29 29 20 c-hash key #f))
4210: 20 20 3b 3b 20 28 6c 69 73 74 20 74 65 73 74 2d ;; (list test-
4220: 69 64 20 73 74 61 74 65 20 73 74 61 74 75 73 29 id state status)
4230: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4240: 20 20 20 20 20 20 28 73 72 63 2d 74 65 73 74 2d (src-test-
4250: 69 64 20 20 20 28 69 66 20 73 72 63 2d 76 61 6c id (if src-val
4260: 75 65 20 28 6c 69 73 74 2d 72 65 66 20 73 72 63 ue (list-ref src
4270: 2d 76 61 6c 75 65 20 30 29 20 23 66 29 29 0a 20 -value 0) #f)).
4280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4290: 20 20 20 20 28 73 72 63 2d 73 74 61 74 65 20 20 (src-state
42a0: 20 20 20 28 69 66 20 73 72 63 2d 76 61 6c 75 65 (if src-value
42b0: 20 28 6c 69 73 74 2d 72 65 66 20 73 72 63 2d 76 (list-ref src-v
42c0: 61 6c 75 65 20 31 29 20 23 66 29 29 0a 20 20 20 alue 1) #f)).
42d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42e0: 20 20 28 73 72 63 2d 73 74 61 74 75 73 20 20 20 (src-status
42f0: 20 28 69 66 20 73 72 63 2d 76 61 6c 75 65 20 28 (if src-value (
4300: 6c 69 73 74 2d 72 65 66 20 73 72 63 2d 76 61 6c list-ref src-val
4310: 75 65 20 32 29 20 23 66 29 29 0a 0a 20 20 20 20 ue 2) #f))..
4320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4330: 20 28 69 6e 63 6f 6d 70 6c 65 74 65 2d 73 74 61 (incomplete-sta
4340: 74 75 73 65 73 20 27 28 22 44 45 4c 45 54 45 44 tuses '("DELETED
4350: 22 20 22 49 4e 43 4f 4d 50 4c 45 54 45 22 20 22 " "INCOMPLETE" "
4360: 53 54 55 43 4b 2f 44 45 41 44 22 20 22 4e 2f 41 STUCK/DEAD" "N/A
4370: 22 29 29 20 3b 3b 20 69 66 20 61 6e 79 20 6f 66 ")) ;; if any of
4380: 20 74 68 65 73 65 20 73 74 61 74 75 73 65 73 20 these statuses
4390: 61 70 70 6c 79 2c 20 74 72 65 61 74 20 74 65 73 apply, treat tes
43a0: 74 20 61 73 20 69 6e 63 6f 6d 70 6c 65 74 65 0a t as incomplete.
43b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
43c0: 20 20 20 20 20 20 28 64 65 73 74 2d 63 6f 6d 70 (dest-comp
43d0: 6c 65 74 65 0a 20 20 20 20 20 20 20 20 20 20 20 lete.
43e0: 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 (and
43f0: 64 65 73 74 2d 76 61 6c 75 65 20 64 65 73 74 2d dest-value dest-
4400: 73 74 61 74 65 20 64 65 73 74 2d 73 74 61 74 75 state dest-statu
4410: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
4420: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 71 (eq
4430: 75 61 6c 3f 20 64 65 73 74 2d 73 74 61 74 65 20 ual? dest-state
4440: 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 20 20 20 "COMPLETED").
4450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4460: 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 6d 65 (not (me
4470: 6d 62 65 72 20 64 65 73 74 2d 73 74 61 74 75 73 mber dest-status
4480: 20 69 6e 63 6f 6d 70 6c 65 74 65 2d 73 74 61 74 incomplete-stat
4490: 75 73 65 73 29 29 29 29 0a 20 20 20 20 20 20 20 uses)))).
44a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
44b0: 72 63 2d 63 6f 6d 70 6c 65 74 65 0a 20 20 20 20 rc-complete.
44c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44d0: 20 20 28 61 6e 64 20 73 72 63 2d 76 61 6c 75 65 (and src-value
44e0: 20 73 72 63 2d 73 74 61 74 65 20 73 72 63 2d 73 src-state src-s
44f0: 74 61 74 75 73 0a 20 20 20 20 20 20 20 20 20 20 tatus.
4500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4510: 20 28 65 71 75 61 6c 3f 20 73 72 63 2d 73 74 61 (equal? src-sta
4520: 74 65 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a te "COMPLETED").
4530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4540: 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 20 (not
4550: 28 6d 65 6d 62 65 72 20 73 72 63 2d 73 74 61 74 (member src-stat
4560: 75 73 20 69 6e 63 6f 6d 70 6c 65 74 65 2d 73 74 us incomplete-st
4570: 61 74 75 73 65 73 29 29 29 29 0a 20 20 20 20 20 atuses)))).
4580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4590: 28 73 74 61 74 75 73 2d 63 6f 6d 70 61 72 65 2d (status-compare-
45a0: 72 65 73 75 6c 74 20 28 64 63 6f 6d 6d 6f 6e 3a result (dcommon:
45b0: 73 74 61 74 75 73 2d 63 6f 6d 70 61 72 65 33 20 status-compare3
45c0: 73 72 63 2d 73 74 61 74 75 73 20 64 65 73 74 2d src-status dest-
45d0: 73 74 61 74 75 73 29 29 0a 20 20 20 20 20 20 20 status)).
45e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 78 (x
45f0: 6f 72 2d 6e 65 77 2d 69 74 65 6d 0a 20 20 20 20 or-new-item.
4600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4610: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
4620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
4630: 3b 20 63 6f 6d 70 6c 65 74 65 2c 20 66 6f 72 20 ; complete, for
4640: 74 68 69 73 20 63 61 73 65 20 6d 65 61 6e 73 3a this case means:
4650: 20 73 74 61 74 65 3d 63 6f 6d 70 65 6c 74 65 20 state=compelte
4660: 41 4e 44 20 73 74 61 74 75 73 20 6e 6f 74 20 69 AND status not i
4670: 6e 20 28 20 64 65 6c 65 74 65 64 20 75 6e 63 6f n ( deleted unco
4680: 6d 70 6c 65 74 65 20 73 74 75 63 6b 2f 64 65 61 mplete stuck/dea
4690: 64 20 6e 2f 61 20 29 0a 20 20 20 20 20 20 20 20 d n/a ).
46a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
46b0: 3b 20 6e 65 69 74 68 65 72 20 63 6f 6d 70 6c 65 ; neither comple
46c0: 74 65 20 2d 3e 20 62 61 64 0a 0a 20 20 20 20 20 te -> bad..
46d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46e0: 20 20 3b 3b 20 73 72 63 20 21 63 6f 6d 70 6c 65 ;; src !comple
46f0: 74 65 2c 20 64 65 73 74 20 63 6f 6d 70 6c 65 74 te, dest complet
4700: 65 20 2d 3e 20 62 65 74 74 65 72 0a 20 20 20 20 e -> better.
4710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4720: 20 20 20 28 28 61 6e 64 20 28 6e 6f 74 20 64 65 ((and (not de
4730: 73 74 2d 63 6f 6d 70 6c 65 74 65 29 20 28 6e 6f st-complete) (no
4740: 74 20 73 72 63 2d 63 6f 6d 70 6c 65 74 65 29 29 t src-complete))
4750: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4760: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 64 (list d
4770: 65 73 74 2d 74 65 73 74 2d 69 64 20 22 42 4f 54 est-test-id "BOT
4780: 48 2d 42 41 44 22 20 22 42 4f 54 48 2d 49 4e 43 H-BAD" "BOTH-INC
4790: 4f 4d 50 4c 45 54 45 22 29 29 0a 20 20 20 20 20 OMPLETE")).
47a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47b0: 20 20 28 28 6e 6f 74 20 64 65 73 74 2d 63 6f 6d ((not dest-com
47c0: 70 6c 65 74 65 29 0a 20 20 20 20 20 20 20 20 20 plete).
47d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
47e0: 6c 69 73 74 20 73 72 63 2d 74 65 73 74 2d 69 64 list src-test-id
47f0: 20 22 44 49 46 46 2d 4d 49 53 53 49 4e 47 22 20 "DIFF-MISSING"
4800: 22 44 45 53 54 2d 49 4e 43 4f 4d 50 4c 45 54 45 "DEST-INCOMPLETE
4810: 22 29 29 20 20 0a 20 20 20 20 20 20 20 20 20 20 ")) .
4820: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6e ((n
4830: 6f 74 20 73 72 63 2d 63 6f 6d 70 6c 65 74 65 29 ot src-complete)
4840: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4850: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 64 (list d
4860: 65 73 74 2d 74 65 73 74 2d 69 64 20 22 44 49 46 est-test-id "DIF
4870: 46 2d 4e 45 57 22 20 22 53 52 43 2d 49 4e 43 4f F-NEW" "SRC-INCO
4880: 4d 50 4c 45 54 45 22 29 29 20 20 20 20 20 20 0a MPLETE")) .
4890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48a0: 20 20 20 20 20 20 20 28 28 61 6e 64 0a 20 20 20 ((and.
48b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48c0: 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 73 72 (equal? sr
48d0: 63 2d 73 74 61 74 65 20 64 65 73 74 2d 73 74 61 c-state dest-sta
48e0: 74 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 te).
48f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 71 (eq
4900: 75 61 6c 3f 20 73 72 63 2d 73 74 61 74 75 73 20 ual? src-status
4910: 64 65 73 74 2d 73 74 61 74 75 73 29 29 0a 20 20 dest-status)).
4920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4930: 20 20 20 20 20 20 28 6c 69 73 74 20 64 65 73 74 (list dest
4940: 2d 74 65 73 74 2d 69 64 20 20 28 63 6f 6e 63 20 -test-id (conc
4950: 22 43 4c 45 41 4e 22 29 20 28 63 6f 6e 63 20 22 "CLEAN") (conc "
4960: 43 4c 45 41 4e 2d 22 20 64 65 73 74 2d 73 74 61 CLEAN-" dest-sta
4970: 74 75 73 29 20 29 29 20 0a 20 20 20 20 20 20 20 tus) )) .
4980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4990: 3b 3b 20 20 20 20 62 65 74 74 65 72 20 6f 72 20 ;; better or
49a0: 77 6f 72 73 65 3a 20 70 61 73 73 20 3e 20 77 61 worse: pass > wa
49b0: 72 6e 20 3e 20 77 61 69 76 65 64 20 3e 20 73 6b rn > waived > sk
49c0: 69 70 20 3e 20 66 61 69 6c 20 3e 20 61 62 6f 72 ip > fail > abor
49d0: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
49e0: 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 ;;
49f0: 70 61 73 73 20 3e 20 77 61 72 6e 20 3e 20 77 61 pass > warn > wa
4a00: 69 76 65 64 20 3e 20 73 6b 69 70 20 3e 20 66 61 ived > skip > fa
4a10: 69 6c 20 3e 20 61 62 6f 72 74 0a 20 20 20 20 20 il > abort.
4a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a30: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4a40: 20 20 20 20 20 20 20 20 20 20 28 28 3d 20 31 20 ((= 1
4a50: 73 74 61 74 75 73 2d 63 6f 6d 70 61 72 65 2d 72 status-compare-r
4a60: 65 73 75 6c 74 29 20 3b 3b 20 73 72 63 20 69 73 esult) ;; src is
4a70: 20 62 65 74 74 65 72 2c 20 64 65 73 74 20 69 73 better, dest is
4a80: 20 77 6f 72 73 65 0a 20 20 20 20 20 20 20 20 20 worse.
4a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4aa0: 6c 69 73 74 20 64 65 73 74 2d 74 65 73 74 2d 69 list dest-test-i
4ab0: 64 20 22 44 49 52 54 59 2d 57 4f 52 53 45 22 20 d "DIRTY-WORSE"
4ac0: 28 63 6f 6e 63 20 73 72 63 2d 73 74 61 74 75 73 (conc src-status
4ad0: 20 22 2d 3e 22 20 64 65 73 74 2d 73 74 61 74 75 "->" dest-statu
4ae0: 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s))).
4af0: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
4b00: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
4b10: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 (list
4b20: 64 65 73 74 2d 74 65 73 74 2d 69 64 20 22 44 49 dest-test-id "DI
4b30: 52 54 59 2d 42 45 54 54 45 52 22 20 28 63 6f 6e RTY-BETTER" (con
4b40: 63 20 73 72 63 2d 73 74 61 74 75 73 20 22 2d 3e c src-status "->
4b50: 22 20 64 65 73 74 2d 73 74 61 74 75 73 29 29 29 " dest-status)))
4b60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4b70: 20 20 20 20 20 20 20 20 29 29 29 0a 20 20 20 20 ))).
4b80: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 (lis
4b90: 74 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d t test-name item
4ba0: 2d 70 61 74 68 20 20 78 6f 72 2d 6e 65 77 2d 69 -path xor-new-i
4bb0: 74 65 6d 29 29 29 0a 20 20 20 20 20 20 20 20 20 tem))).
4bc0: 20 20 20 61 6c 6c 2d 6b 65 79 73 29 29 29 0a 0a all-keys)))..
4bd0: 20 20 20 20 20 20 28 69 66 20 68 69 64 65 2d 63 (if hide-c
4be0: 6c 65 61 6e 0a 20 20 20 20 20 20 20 20 20 20 28 lean. (
4bf0: 66 69 6c 74 65 72 0a 20 20 20 20 20 20 20 20 20 filter.
4c00: 20 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 (lambda (item)
4c10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b . ;;
4c20: 28 70 72 69 6e 74 20 69 74 65 6d 29 0a 20 20 20 (print item).
4c30: 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 0a 20 (not.
4c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 71 (eq
4c50: 75 61 6c 3f 0a 20 20 20 20 20 20 20 20 20 20 20 ual?.
4c60: 20 20 20 20 22 43 4c 45 41 4e 22 0a 20 20 20 20 "CLEAN".
4c70: 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 (list
4c80: 2d 72 65 66 20 28 6c 69 73 74 2d 72 65 66 20 69 -ref (list-ref i
4c90: 74 65 6d 20 32 29 20 31 29 29 29 29 0a 20 20 20 tem 2) 1)))).
4ca0: 20 20 20 20 20 20 20 20 72 65 73 29 0a 20 20 20 res).
4cb0: 20 20 20 20 20 20 20 72 65 73 29 29 29 29 0a 0a res))))..
4cc0: 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e (define (dcommon
4cd0: 3a 65 78 61 6d 69 6e 65 2d 78 74 65 72 6d 20 72 :examine-xterm r
4ce0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 un-id test-id).
4cf0: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 64 61 74 (let* ((testdat
4d00: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 (rmt:get-test-i
4d10: 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 nfo-by-id run-id
4d20: 20 74 65 73 74 2d 69 64 29 29 29 0a 20 20 20 20 test-id))).
4d30: 28 69 66 20 28 6e 6f 74 20 74 65 73 74 64 61 74 (if (not testdat
4d40: 29 0a 20 20 20 20 20 20 20 20 28 62 65 67 69 6e ). (begin
4d50: 0a 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 . (debu
4d60: 67 3a 70 72 69 6e 74 20 32 20 22 45 52 52 4f 52 g:print 2 "ERROR
4d70: 3a 20 4e 6f 20 74 65 73 74 20 64 61 74 61 20 66 : No test data f
4d80: 6f 75 6e 64 20 66 6f 72 20 74 65 73 74 20 22 20 ound for test "
4d90: 74 65 73 74 2d 69 64 20 22 2c 20 65 78 69 74 69 test-id ", exiti
4da0: 6e 67 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 ng"). (
4db0: 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 20 20 exit 1)).
4dc0: 20 28 6c 65 74 2a 0a 20 20 20 20 20 20 20 20 20 (let*.
4dd0: 20 20 20 28 28 72 75 6e 64 69 72 20 20 20 20 20 ((rundir
4de0: 20 20 20 28 69 66 20 74 65 73 74 64 61 74 20 0a (if testdat .
4df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e10: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run
4e20: 64 69 72 20 74 65 73 74 64 61 74 29 0a 20 20 20 dir testdat).
4e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f 67 log
4e50: 66 69 6c 65 29 29 0a 20 20 20 20 20 20 20 20 20 file)).
4e60: 20 20 20 20 28 74 65 73 74 66 75 6c 6c 6e 61 6d (testfullnam
4e70: 65 20 20 28 69 66 20 74 65 73 74 64 61 74 20 28 e (if testdat (
4e80: 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c db:test-get-full
4e90: 6e 61 6d 65 20 74 65 73 74 64 61 74 29 20 22 47 name testdat) "G
4ea0: 61 74 68 65 72 69 6e 67 20 64 61 74 61 20 2e 2e athering data ..
4eb0: 2e 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 .")).
4ec0: 20 20 28 78 74 65 72 6d 20 20 20 20 20 20 28 6c (xterm (l
4ed0: 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 ambda ().
4ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ef0: 20 20 20 20 28 69 66 20 28 64 69 72 65 63 74 6f (if (directo
4f00: 72 79 2d 65 78 69 73 74 73 3f 20 72 75 6e 64 69 ry-exists? rundi
4f10: 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 r).
4f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f30: 20 20 28 6c 65 74 2a 20 28 28 73 68 65 6c 6c 20 (let* ((shell
4f40: 28 69 66 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e (if (get-environ
4f50: 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 ment-variable "S
4f60: 48 45 4c 4c 22 29 20 0a 20 20 20 20 20 20 20 20 HELL") .
4f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f90: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 (conc "
4fa0: 2d 65 20 22 20 28 67 65 74 2d 65 6e 76 69 72 6f -e " (get-enviro
4fb0: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
4fc0: 53 48 45 4c 4c 22 29 29 0a 20 20 20 20 20 20 20 SHELL")).
4fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ff0: 20 20 20 20 20 20 20 20 20 20 22 22 29 29 0a 20 "")).
5000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5020: 20 20 20 20 20 28 63 6f 6d 6d 61 6e 64 20 28 63 (command (c
5030: 6f 6e 63 20 22 63 64 20 22 20 72 75 6e 64 69 72 onc "cd " rundir
5040: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5070: 20 20 20 20 20 20 20 22 3b 6d 74 5f 78 74 65 72 ";mt_xter
5080: 6d 20 2d 54 20 5c 22 22 20 28 73 74 72 69 6e 67 m -T \"" (string
5090: 2d 74 72 61 6e 73 6c 61 74 65 20 74 65 73 74 66 -translate testf
50a0: 75 6c 6c 6e 61 6d 65 20 22 28 29 22 20 22 20 20 ullname "()" "
50b0: 22 29 20 22 5c 22 20 22 20 73 68 65 6c 6c 20 22 ") "\" " shell "
50c0: 26 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 &"))).
50d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50e0: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 43 (print "C
50f0: 6f 6d 6d 61 6e 64 20 3d 22 20 63 6f 6d 6d 61 6e ommand =" comman
5100: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
5110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5120: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 77 69 74 68 (common:with
5130: 6f 75 74 2d 76 61 72 73 0a 20 20 20 20 20 20 20 out-vars.
5140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5150: 20 20 20 20 20 20 20 20 20 20 20 63 6f 6d 6d 61 comma
5160: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
5170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5180: 20 20 20 20 20 22 4d 54 5f 2e 2a 22 29 29 0a 20 "MT_.*")).
5190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d (m
51b0: 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 20 20 28 essage-window (
51c0: 63 6f 6e 63 20 22 44 69 72 65 63 74 6f 72 79 20 conc "Directory
51d0: 22 20 72 75 6e 64 69 72 20 22 20 6e 6f 74 20 66 " rundir " not f
51e0: 6f 75 6e 64 22 29 29 29 29 29 29 0a 20 20 20 20 ound")))))).
51f0: 20 20 20 20 20 20 28 78 74 65 72 6d 29 0a 20 20 (xterm).
5200: 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 (print "
5210: 41 64 64 69 6e 67 20 78 74 65 72 6d 20 63 6f 64 Adding xterm cod
5220: 65 22 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d e")))))..;;=====
5230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5270: 3d 0a 3b 3b 20 44 20 41 20 54 20 41 20 20 20 54 =.;; D A T A T
5280: 20 41 20 42 20 4c 20 45 20 53 0a 3b 3b 3d 3d 3d A B L E S.;;===
5290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
52d0: 3d 3d 3d 0a 0a 3b 3b 20 54 61 62 6c 65 20 6f 66 ===..;; Table of
52e0: 20 6b 65 79 73 0a 28 64 65 66 69 6e 65 20 28 64 keys.(define (d
52f0: 63 6f 6d 6d 6f 6e 3a 6b 65 79 73 2d 6d 61 74 72 common:keys-matr
5300: 69 78 20 72 61 77 63 6f 6e 66 69 67 29 0a 20 20 ix rawconfig).
5310: 28 6c 65 74 2a 20 28 28 63 75 72 72 2d 72 6f 77 (let* ((curr-row
5320: 2d 6e 75 6d 20 31 29 0a 20 20 20 20 20 20 20 20 -num 1).
5330: 20 28 6b 65 79 2d 76 61 6c 73 20 20 20 20 20 28 (key-vals (
5340: 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d configf:section-
5350: 76 61 72 73 20 72 61 77 63 6f 6e 66 69 67 20 22 vars rawconfig "
5360: 66 69 65 6c 64 73 22 29 29 0a 20 20 20 20 20 20 fields")).
5370: 20 20 20 28 6b 65 79 73 2d 6d 61 74 72 69 78 20 (keys-matrix
5380: 20 28 69 75 70 3a 6d 61 74 72 69 78 0a 20 20 20 (iup:matrix.
5390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53a0: 20 20 20 20 20 23 3a 61 6c 69 67 6e 6d 65 6e 74 #:alignment
53b0: 31 20 22 41 4c 45 46 54 22 0a 20 20 20 20 20 20 1 "ALEFT".
53c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53d0: 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 #:expand "YES"
53e0: 20 3b 3b 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 ;; "HORIZONTAL"
53f0: 20 3b 3b 20 22 56 45 52 54 49 43 41 4c 22 0a 20 ;; "VERTICAL".
5400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5410: 20 20 20 20 20 20 20 3b 3b 20 23 3a 73 63 72 6f ;; #:scro
5420: 6c 6c 62 61 72 20 22 59 45 53 22 0a 20 20 20 20 llbar "YES".
5430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5440: 20 20 20 20 23 3a 6e 75 6d 63 6f 6c 20 31 0a 20 #:numcol 1.
5450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5460: 20 20 20 20 20 20 20 23 3a 6e 75 6d 6c 69 6e 20 #:numlin
5470: 28 6c 65 6e 67 74 68 20 6b 65 79 2d 76 61 6c 73 (length key-vals
5480: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5490: 20 20 20 20 20 20 20 20 20 20 23 3a 6e 75 6d 63 #:numc
54a0: 6f 6c 2d 76 69 73 69 62 6c 65 20 31 0a 20 20 20 ol-visible 1.
54b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
54c0: 20 20 20 20 20 23 3a 6e 75 6d 6c 69 6e 2d 76 69 #:numlin-vi
54d0: 73 69 62 6c 65 20 28 6c 65 6e 67 74 68 20 6b 65 sible (length ke
54e0: 79 2d 76 61 6c 73 29 0a 20 20 20 20 20 20 20 20 y-vals).
54f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5500: 23 3a 63 6c 69 63 6b 2d 63 62 20 28 6c 61 6d 62 #:click-cb (lamb
5510: 64 61 20 28 6f 62 6a 20 6c 69 6e 20 63 6f 6c 20 da (obj lin col
5520: 73 74 61 74 75 73 29 0a 20 20 20 20 20 20 20 20 status).
5530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5540: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 (pr
5550: 69 6e 74 20 22 6f 62 6a 3a 20 22 20 6f 62 6a 20 int "obj: " obj
5560: 22 20 6c 69 6e 3a 20 22 20 6c 69 6e 20 22 20 63 " lin: " lin " c
5570: 6f 6c 3a 20 22 20 63 6f 6c 20 22 20 73 74 61 74 ol: " col " stat
5580: 75 73 3a 20 22 20 73 74 61 74 75 73 29 29 29 29 us: " status))))
5590: 29 0a 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 ). ;; (iup:at
55a0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6b 65 79 tribute-set! key
55b0: 73 2d 6d 61 74 72 69 78 20 22 30 3a 30 22 20 22 s-matrix "0:0" "
55c0: 52 75 6e 20 4b 65 79 73 22 29 0a 20 20 20 20 28 Run Keys"). (
55d0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
55e0: 74 21 20 6b 65 79 73 2d 6d 61 74 72 69 78 20 22 t! keys-matrix "
55f0: 57 49 44 54 48 30 22 20 30 29 0a 20 20 20 20 28 WIDTH0" 0). (
5600: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
5610: 74 21 20 6b 65 79 73 2d 6d 61 74 72 69 78 20 22 t! keys-matrix "
5620: 30 3a 31 22 20 22 4b 65 79 20 4e 61 6d 65 22 29 0:1" "Key Name")
5630: 0a 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 . ;; (iup:att
5640: 72 69 62 75 74 65 2d 73 65 74 21 20 6b 65 79 73 ribute-set! keys
5650: 2d 6d 61 74 72 69 78 20 22 57 49 44 54 48 31 22 -matrix "WIDTH1"
5660: 20 22 31 30 30 22 29 0a 20 20 20 20 3b 3b 20 66 "100"). ;; f
5670: 69 6c 6c 20 69 6e 20 6b 65 79 73 0a 20 20 20 20 ill in keys.
5680: 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 (for-each .
5690: 28 6c 61 6d 62 64 61 20 28 76 61 72 29 0a 20 20 (lambda (var).
56a0: 20 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 ;; (iup:att
56b0: 72 69 62 75 74 65 2d 73 65 74 21 20 6b 65 79 73 ribute-set! keys
56c0: 2d 6d 61 74 72 69 78 20 22 41 44 44 4c 49 4e 22 -matrix "ADDLIN"
56d0: 20 28 63 6f 6e 63 20 63 75 72 72 2d 72 6f 77 2d (conc curr-row-
56e0: 6e 75 6d 29 29 0a 20 20 20 20 20 20 20 28 69 75 num)). (iu
56f0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
5700: 20 6b 65 79 73 2d 6d 61 74 72 69 78 20 28 63 6f keys-matrix (co
5710: 6e 63 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 nc curr-row-num
5720: 22 3a 30 22 29 20 63 75 72 72 2d 72 6f 77 2d 6e ":0") curr-row-n
5730: 75 6d 29 0a 20 20 20 20 20 20 20 28 69 75 70 3a um). (iup:
5740: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6b attribute-set! k
5750: 65 79 73 2d 6d 61 74 72 69 78 20 28 63 6f 6e 63 eys-matrix (conc
5760: 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 22 3a curr-row-num ":
5770: 31 22 29 20 76 61 72 29 0a 20 20 20 20 20 20 20 1") var).
5780: 28 73 65 74 21 20 63 75 72 72 2d 72 6f 77 2d 6e (set! curr-row-n
5790: 75 6d 20 28 2b 20 31 20 63 75 72 72 2d 72 6f 77 um (+ 1 curr-row
57a0: 2d 6e 75 6d 29 29 29 20 3b 3b 20 28 63 6f 6e 66 -num))) ;; (conf
57b0: 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 ig-lookup *confi
57c0: 67 64 61 74 2a 20 22 66 69 65 6c 64 73 22 20 76 gdat* "fields" v
57d0: 61 72 29 29 29 0a 20 20 20 20 20 6b 65 79 2d 76 ar))). key-v
57e0: 61 6c 73 29 0a 20 20 20 20 28 69 75 70 3a 61 74 als). (iup:at
57f0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6b 65 79 tribute-set! key
5800: 73 2d 6d 61 74 72 69 78 20 22 57 49 44 54 48 44 s-matrix "WIDTHD
5810: 45 46 22 20 22 34 30 22 29 0a 20 20 20 20 6b 65 EF" "40"). ke
5820: 79 73 2d 6d 61 74 72 69 78 29 29 0a 0a 3b 3b 20 ys-matrix))..;;
5830: 53 65 63 74 69 6f 6e 20 74 6f 20 74 61 62 6c 65 Section to table
5840: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f .(define (dcommo
5850: 6e 3a 73 65 63 74 69 6f 6e 2d 6d 61 74 72 69 78 n:section-matrix
5860: 20 72 61 77 63 6f 6e 66 69 67 20 73 65 63 74 69 rawconfig secti
5870: 6f 6e 6e 61 6d 65 20 76 61 72 63 6f 6c 6e 61 6d onname varcolnam
5880: 65 20 76 61 6c 63 6f 6c 6e 61 6d 65 20 23 21 6b e valcolname #!k
5890: 65 79 20 28 74 69 74 6c 65 20 23 66 29 29 0a 20 ey (title #f)).
58a0: 20 28 6c 65 74 2a 20 28 28 63 75 72 72 2d 72 6f (let* ((curr-ro
58b0: 77 2d 6e 75 6d 20 20 20 20 31 29 0a 20 20 20 20 w-num 1).
58c0: 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 20 (key-vals
58d0: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 73 (configf:s
58e0: 65 63 74 69 6f 6e 2d 76 61 72 73 20 72 61 77 63 ection-vars rawc
58f0: 6f 6e 66 69 67 20 73 65 63 74 69 6f 6e 6e 61 6d onfig sectionnam
5900: 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 73 65 e)). (se
5910: 63 74 69 6f 6e 2d 6d 61 74 72 69 78 20 20 28 69 ction-matrix (i
5920: 75 70 3a 6d 61 74 72 69 78 0a 20 20 20 20 20 20 up:matrix.
5930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5940: 20 20 20 20 20 23 3a 61 6c 69 67 6e 6d 65 6e 74 #:alignment
5950: 31 20 22 41 4c 45 46 54 22 0a 20 20 20 20 20 20 1 "ALEFT".
5960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5970: 20 20 20 20 20 3b 3b 20 23 3a 65 78 70 61 6e 64 ;; #:expand
5980: 20 22 59 45 53 22 20 3b 3b 20 22 48 4f 52 49 5a "YES" ;; "HORIZ
5990: 4f 4e 54 41 4c 22 0a 20 20 20 20 20 20 20 20 20 ONTAL".
59a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59b0: 20 20 23 3a 6e 75 6d 63 6f 6c 20 31 0a 20 20 20 #:numcol 1.
59c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59d0: 20 20 20 20 20 20 20 20 23 3a 6e 75 6d 6c 69 6e #:numlin
59e0: 20 28 6c 65 6e 67 74 68 20 6b 65 79 2d 76 61 6c (length key-val
59f0: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
5a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 3a #:
5a10: 6e 75 6d 63 6f 6c 2d 76 69 73 69 62 6c 65 20 31 numcol-visible 1
5a20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5a30: 20 20 20 20 20 20 20 20 20 20 20 20 23 3a 6e 75 #:nu
5a40: 6d 6c 69 6e 2d 76 69 73 69 62 6c 65 20 28 6d 69 mlin-visible (mi
5a50: 6e 20 31 30 20 28 6c 65 6e 67 74 68 20 6b 65 79 n 10 (length key
5a60: 2d 76 61 6c 73 29 29 0a 09 09 09 20 20 20 23 3a -vals)).... #:
5a70: 73 63 72 6f 6c 6c 62 61 72 20 22 59 45 53 22 29 scrollbar "YES")
5a80: 29 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 )). (iup:attr
5a90: 69 62 75 74 65 2d 73 65 74 21 20 73 65 63 74 69 ibute-set! secti
5aa0: 6f 6e 2d 6d 61 74 72 69 78 20 22 30 3a 30 22 20 on-matrix "0:0"
5ab0: 76 61 72 63 6f 6c 6e 61 6d 65 29 0a 20 20 20 20 varcolname).
5ac0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
5ad0: 65 74 21 20 73 65 63 74 69 6f 6e 2d 6d 61 74 72 et! section-matr
5ae0: 69 78 20 22 30 3a 31 22 20 76 61 6c 63 6f 6c 6e ix "0:1" valcoln
5af0: 61 6d 65 29 0a 20 20 20 20 28 69 75 70 3a 61 74 ame). (iup:at
5b00: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 63 tribute-set! sec
5b10: 74 69 6f 6e 2d 6d 61 74 72 69 78 20 22 57 49 44 tion-matrix "WID
5b20: 54 48 31 22 20 22 32 30 30 22 29 0a 20 20 20 20 TH1" "200").
5b30: 3b 3b 20 66 69 6c 6c 20 69 6e 20 6b 65 79 73 0a ;; fill in keys.
5b40: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 (for-each .
5b50: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 61 72 (lambda (var
5b60: 29 0a 20 20 20 20 20 20 20 3b 3b 20 28 69 75 70 ). ;; (iup
5b70: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
5b80: 6b 65 79 73 2d 6d 61 74 72 69 78 20 22 41 44 44 keys-matrix "ADD
5b90: 4c 49 4e 22 20 28 63 6f 6e 63 20 63 75 72 72 2d LIN" (conc curr-
5ba0: 72 6f 77 2d 6e 75 6d 29 29 0a 20 20 20 20 20 20 row-num)).
5bb0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
5bc0: 73 65 74 21 20 73 65 63 74 69 6f 6e 2d 6d 61 74 set! section-mat
5bd0: 72 69 78 20 28 63 6f 6e 63 20 63 75 72 72 2d 72 rix (conc curr-r
5be0: 6f 77 2d 6e 75 6d 20 22 3a 30 22 29 20 76 61 72 ow-num ":0") var
5bf0: 29 0a 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 ). (iup:at
5c00: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 63 tribute-set! sec
5c10: 74 69 6f 6e 2d 6d 61 74 72 69 78 20 28 63 6f 6e tion-matrix (con
5c20: 63 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 22 c curr-row-num "
5c30: 3a 31 22 29 20 28 63 6f 6e 66 69 67 66 3a 6c 6f :1") (configf:lo
5c40: 6f 6b 75 70 20 72 61 77 63 6f 6e 66 69 67 20 73 okup rawconfig s
5c50: 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 29 29 ectionname var))
5c60: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 63 75 . (set! cu
5c70: 72 72 2d 72 6f 77 2d 6e 75 6d 20 28 2b 20 31 20 rr-row-num (+ 1
5c80: 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 29 29 29 20 curr-row-num)))
5c90: 3b 3b 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 ;; (config-looku
5ca0: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 66 p *configdat* "f
5cb0: 69 65 6c 64 73 22 20 76 61 72 29 29 29 0a 20 20 ields" var))).
5cc0: 20 20 20 6b 65 79 2d 76 61 6c 73 29 0a 20 20 20 key-vals).
5cd0: 20 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 20 20 (iup:vbox.
5ce0: 28 69 75 70 3a 6c 61 62 65 6c 20 28 69 66 20 74 (iup:label (if t
5cf0: 69 74 6c 65 20 74 69 74 6c 65 20 28 63 6f 6e 63 itle title (conc
5d00: 20 22 53 65 74 74 69 6e 67 73 20 66 72 6f 6d 20 "Settings from
5d10: 5b 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 22 [" sectionname "
5d20: 5d 22 29 29 20 20 0a 20 20 20 20 20 20 20 20 20 ]")) .
5d30: 09 3b 3b 20 23 3a 73 69 7a 65 20 20 20 22 35 78 .;; #:size "5x
5d40: 22 0a 20 20 20 20 20 20 20 20 20 09 23 3a 65 78 ". .#:ex
5d50: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL
5d60: 22 0a 20 20 20 20 20 20 20 20 20 09 29 0a 20 20 ". .).
5d70: 20 20 20 73 65 63 74 69 6f 6e 2d 6d 61 74 72 69 section-matri
5d80: 78 29 29 29 0a 20 20 20 20 0a 3b 3b 20 47 65 6e x))). .;; Gen
5d90: 65 72 61 6c 20 64 61 74 61 0a 3b 3b 0a 28 64 65 eral data.;;.(de
5da0: 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 fine (dcommon:ge
5db0: 6e 65 72 61 6c 2d 69 6e 66 6f 29 0a 20 20 28 6c neral-info). (l
5dc0: 65 74 20 28 28 67 65 6e 65 72 61 6c 2d 6d 61 74 et ((general-mat
5dd0: 72 69 78 20 28 69 75 70 3a 6d 61 74 72 69 78 0a rix (iup:matrix.
5de0: 09 09 09 20 23 3a 61 6c 69 67 6e 6d 65 6e 74 31 ... #:alignment1
5df0: 20 22 41 4c 45 46 54 22 0a 09 09 09 20 23 3a 65 "ALEFT".... #:e
5e00: 78 70 61 6e 64 20 22 59 45 53 22 20 3b 3b 20 22 xpand "YES" ;; "
5e10: 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 20 HORIZONTAL"....
5e20: 23 3a 6e 75 6d 63 6f 6c 20 31 0a 09 09 09 20 23 #:numcol 1.... #
5e30: 3a 6e 75 6d 6c 69 6e 20 32 0a 09 09 09 20 23 3a :numlin 2.... #:
5e40: 6e 75 6d 63 6f 6c 2d 76 69 73 69 62 6c 65 20 31 numcol-visible 1
5e50: 0a 09 09 09 20 23 3a 6e 75 6d 6c 69 6e 2d 76 69 .... #:numlin-vi
5e60: 73 69 62 6c 65 20 32 29 29 29 0a 20 20 20 20 28 sible 2))). (
5e70: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
5e80: 74 21 20 67 65 6e 65 72 61 6c 2d 6d 61 74 72 69 t! general-matri
5e90: 78 20 22 57 49 44 54 48 31 22 20 22 31 35 30 22 x "WIDTH1" "150"
5ea0: 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 ). (iup:attri
5eb0: 62 75 74 65 2d 73 65 74 21 20 67 65 6e 65 72 61 bute-set! genera
5ec0: 6c 2d 6d 61 74 72 69 78 20 22 30 3a 31 22 20 22 l-matrix "0:1" "
5ed0: 41 62 6f 75 74 20 74 68 69 73 20 4d 65 67 61 74 About this Megat
5ee0: 65 73 74 20 61 72 65 61 22 29 20 0a 20 20 20 20 est area") .
5ef0: 3b 3b 20 55 73 65 72 20 28 74 68 69 73 20 69 73 ;; User (this is
5f00: 20 6e 6f 74 20 61 6c 77 61 79 73 20 6f 62 76 69 not always obvi
5f10: 6f 75 73 20 2d 20 69 74 20 69 73 20 63 6f 6d 6d ous - it is comm
5f20: 6f 6e 20 74 6f 20 72 75 6e 20 61 73 20 61 20 64 on to run as a d
5f30: 69 66 66 65 72 65 6e 74 20 75 73 65 72 0a 20 20 ifferent user.
5f40: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
5f50: 2d 73 65 74 21 20 67 65 6e 65 72 61 6c 2d 6d 61 -set! general-ma
5f60: 74 72 69 78 20 22 31 3a 30 22 20 22 55 73 65 72 trix "1:0" "User
5f70: 22 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 "). (iup:attr
5f80: 69 62 75 74 65 2d 73 65 74 21 20 67 65 6e 65 72 ibute-set! gener
5f90: 61 6c 2d 6d 61 74 72 69 78 20 22 31 3a 31 22 20 al-matrix "1:1"
5fa0: 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 (current-user-na
5fb0: 6d 65 29 29 0a 20 20 20 20 3b 3b 20 4d 65 67 61 me)). ;; Mega
5fc0: 74 65 73 74 20 61 72 65 61 0a 20 20 20 20 3b 3b test area. ;;
5fd0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
5fe0: 73 65 74 21 20 67 65 6e 65 72 61 6c 2d 6d 61 74 set! general-mat
5ff0: 72 69 78 20 22 32 3a 30 22 20 22 41 72 65 61 22 rix "2:0" "Area"
6000: 29 0a 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 ). ;; (iup:at
6010: 74 72 69 62 75 74 65 2d 73 65 74 21 20 67 65 6e tribute-set! gen
6020: 65 72 61 6c 2d 6d 61 74 72 69 78 20 22 32 3a 31 eral-matrix "2:1
6030: 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 " *toppath*).
6040: 20 3b 3b 20 4d 65 67 61 74 65 73 74 20 76 65 72 ;; Megatest ver
6050: 73 69 6f 6e 0a 20 20 20 20 28 69 75 70 3a 61 74 sion. (iup:at
6060: 74 72 69 62 75 74 65 2d 73 65 74 21 20 67 65 6e tribute-set! gen
6070: 65 72 61 6c 2d 6d 61 74 72 69 78 20 22 32 3a 30 eral-matrix "2:0
6080: 22 20 22 56 65 72 73 69 6f 6e 22 29 0a 20 20 20 " "Version").
6090: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
60a0: 73 65 74 21 20 67 65 6e 65 72 61 6c 2d 6d 61 74 set! general-mat
60b0: 72 69 78 20 22 32 3a 31 22 20 28 63 6f 6e 63 20 rix "2:1" (conc
60c0: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
60d0: 20 22 2d 22 20 28 73 75 62 73 74 72 69 6e 67 20 "-" (substring
60e0: 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d megatest-fossil-
60f0: 68 61 73 68 20 30 20 34 29 29 29 0a 0a 20 20 20 hash 0 4)))..
6100: 20 67 65 6e 65 72 61 6c 2d 6d 61 74 72 69 78 29 general-matrix)
6110: 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d )..(define (dcom
6120: 6d 6f 6e 3a 72 75 6e 2d 73 74 61 74 73 20 63 6f mon:run-stats co
6130: 6d 6d 6f 6e 64 61 74 20 74 61 62 64 61 74 20 23 mmondat tabdat #
6140: 21 6b 65 79 20 28 74 61 62 2d 6e 75 6d 20 23 66 !key (tab-num #f
6150: 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 61 )). (let* ((sta
6160: 74 73 2d 6d 61 74 72 69 78 20 28 69 75 70 3a 6d ts-matrix (iup:m
6170: 61 74 72 69 78 20 65 78 70 61 6e 64 3a 20 22 59 atrix expand: "Y
6180: 45 53 22 29 29 0a 09 20 28 63 68 61 6e 67 65 64 ES")).. (changed
6190: 20 20 20 20 20 20 23 66 29 0a 09 20 28 73 74 61 #f).. (sta
61a0: 74 73 2d 75 70 64 61 74 65 72 20 28 6c 61 6d 62 ts-updater (lamb
61b0: 64 61 20 28 29 0a 09 09 09 20 28 69 66 20 28 64 da ().... (if (d
61c0: 61 73 68 62 6f 61 72 64 3a 64 61 74 61 62 61 73 ashboard:databas
61d0: 65 2d 63 68 61 6e 67 65 64 3f 20 63 6f 6d 6d 6f e-changed? commo
61e0: 6e 64 61 74 20 74 61 62 64 61 74 20 63 6f 6e 74 ndat tabdat cont
61f0: 65 78 74 2d 6b 65 79 3a 20 27 72 75 6e 2d 73 74 ext-key: 'run-st
6200: 61 74 73 29 0a 09 09 09 20 20 20 20 20 28 6c 65 ats).... (le
6210: 74 2a 20 28 28 72 75 6e 2d 73 74 61 74 73 20 20 t* ((run-stats
6220: 20 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d 73 (rmt:get-run-s
6230: 74 61 74 73 29 29 0a 09 09 09 09 20 20 20 20 28 tats))..... (
6240: 69 6e 64 69 63 65 73 20 20 20 20 20 20 28 63 6f indices (co
6250: 6d 6d 6f 6e 3a 73 70 61 72 73 65 2d 6c 69 73 74 mmon:sparse-list
6260: 2d 67 65 6e 65 72 61 74 65 2d 69 6e 64 65 78 20 -generate-index
6270: 72 75 6e 2d 73 74 61 74 73 29 29 20 3b 3b 20 20 run-stats)) ;;
6280: 70 72 6f 63 3a 20 73 65 74 2d 63 65 6c 6c 29 29 proc: set-cell))
6290: 0a 09 09 09 09 20 20 20 20 28 72 6f 77 2d 69 6e ..... (row-in
62a0: 64 69 63 65 73 20 20 28 63 61 72 20 69 6e 64 69 dices (car indi
62b0: 63 65 73 29 29 0a 09 09 09 09 20 20 20 20 28 63 ces))..... (c
62c0: 6f 6c 2d 69 6e 64 69 63 65 73 20 20 28 63 61 64 ol-indices (cad
62d0: 72 20 69 6e 64 69 63 65 73 29 29 0a 09 09 09 09 r indices)).....
62e0: 20 20 20 20 28 6d 61 78 2d 72 6f 77 20 20 20 20 (max-row
62f0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 6f 77 (if (null? row
6300: 2d 69 6e 64 69 63 65 73 29 20 31 20 28 63 6f 6d -indices) 1 (com
6310: 6d 6f 6e 3a 6d 61 78 20 28 6d 61 70 20 63 61 64 mon:max (map cad
6320: 72 20 72 6f 77 2d 69 6e 64 69 63 65 73 29 29 29 r row-indices)))
6330: 29 0a 09 09 09 09 20 20 20 20 28 6d 61 78 2d 63 )..... (max-c
6340: 6f 6c 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c ol (if (nul
6350: 6c 3f 20 63 6f 6c 2d 69 6e 64 69 63 65 73 29 20 l? col-indices)
6360: 31 20 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 1 ....... (
6370: 63 6f 6d 6d 6f 6e 3a 6d 61 78 20 28 6d 61 70 20 common:max (map
6380: 63 61 64 72 20 63 6f 6c 2d 69 6e 64 69 63 65 73 cadr col-indices
6390: 29 29 29 29 0a 09 09 09 09 20 20 20 20 28 6d 61 ))))..... (ma
63a0: 78 2d 76 69 73 69 62 6c 65 20 20 28 6d 61 78 20 x-visible (max
63b0: 28 2d 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 (- (dboard:tabda
63c0: 74 2d 6e 75 6d 2d 74 65 73 74 73 20 74 61 62 64 t-num-tests tabd
63d0: 61 74 29 20 31 35 29 20 33 29 29 0a 09 09 09 09 at) 15) 3)).....
63e0: 20 20 20 20 28 6d 61 78 2d 63 6f 6c 2d 76 69 73 (max-col-vis
63f0: 20 20 28 69 66 20 28 3e 20 6d 61 78 2d 63 6f 6c (if (> max-col
6400: 20 31 30 29 20 31 30 20 6d 61 78 2d 63 6f 6c 29 10) 10 max-col)
6410: 29 0a 09 09 09 09 20 20 20 20 28 6e 75 6d 72 6f )..... (numro
6420: 77 73 20 20 20 20 20 20 31 29 0a 09 09 09 09 20 ws 1).....
6430: 20 20 20 28 6e 75 6d 63 6f 6c 73 20 20 20 20 20 (numcols
6440: 20 31 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 1)).... (
6450: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
6460: 74 21 20 73 74 61 74 73 2d 6d 61 74 72 69 78 20 t! stats-matrix
6470: 22 43 4c 45 41 52 56 41 4c 55 45 22 20 22 43 4f "CLEARVALUE" "CO
6480: 4e 54 45 4e 54 53 22 29 0a 09 09 09 20 20 20 20 NTENTS")....
6490: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
64a0: 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d 61 74 e-set! stats-mat
64b0: 72 69 78 20 22 4e 55 4d 43 4f 4c 22 20 6d 61 78 rix "NUMCOL" max
64c0: 2d 63 6f 6c 20 29 0a 09 09 09 20 20 20 20 20 20 -col )....
64d0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
64e0: 73 65 74 21 20 73 74 61 74 73 2d 6d 61 74 72 69 set! stats-matri
64f0: 78 20 22 4e 55 4d 4c 49 4e 22 20 28 69 66 20 28 x "NUMLIN" (if (
6500: 3c 20 6d 61 78 2d 72 6f 77 20 6d 61 78 2d 76 69 < max-row max-vi
6510: 73 69 62 6c 65 29 20 6d 61 78 2d 76 69 73 69 62 sible) max-visib
6520: 6c 65 20 6d 61 78 2d 72 6f 77 29 29 20 3b 3b 20 le max-row)) ;;
6530: 6d 69 6e 20 6f 66 20 32 30 0a 09 09 09 20 20 20 min of 20....
6540: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
6550: 74 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d 61 te-set! stats-ma
6560: 74 72 69 78 20 22 4e 55 4d 43 4f 4c 5f 56 49 53 trix "NUMCOL_VIS
6570: 49 42 4c 45 22 20 6d 61 78 2d 63 6f 6c 2d 76 69 IBLE" max-col-vi
6580: 73 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 75 s).... (iu
6590: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
65a0: 20 73 74 61 74 73 2d 6d 61 74 72 69 78 20 22 4e stats-matrix "N
65b0: 55 4d 4c 49 4e 5f 56 49 53 49 42 4c 45 22 20 28 UMLIN_VISIBLE" (
65c0: 69 66 20 28 3e 20 6d 61 78 2d 72 6f 77 20 6d 61 if (> max-row ma
65d0: 78 2d 76 69 73 69 62 6c 65 29 20 6d 61 78 2d 76 x-visible) max-v
65e0: 69 73 69 62 6c 65 20 6d 61 78 2d 72 6f 77 29 29 isible max-row))
65f0: 0a 0a 09 09 09 20 20 20 20 20 20 20 3b 3b 20 52 ..... ;; R
6600: 6f 77 20 6c 61 62 65 6c 73 0a 09 09 09 20 20 20 ow labels....
6610: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
6620: 61 6d 62 64 61 20 28 69 6e 64 29 0a 09 09 09 09 ambda (ind).....
6630: 09 20 20 20 28 6c 65 74 2a 20 28 28 6e 61 6d 65 . (let* ((name
6640: 20 28 63 61 72 20 69 6e 64 29 29 0a 09 09 09 09 (car ind)).....
6650: 09 09 20 20 28 6e 75 6d 20 20 28 63 61 64 72 20 .. (num (cadr
6660: 69 6e 64 29 29 0a 09 09 09 09 09 09 20 20 28 6b ind))....... (k
6670: 65 79 20 20 28 63 6f 6e 63 20 6e 75 6d 20 22 3a ey (conc num ":
6680: 30 22 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 0")))......
6690: 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (if (not (equal?
66a0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute
66b0: 73 74 61 74 73 2d 6d 61 74 72 69 78 20 6b 65 79 stats-matrix key
66c0: 29 20 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 20 ) name)).......
66d0: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 (begin.......
66e0: 28 73 65 74 21 20 63 68 61 6e 67 65 64 20 23 74 (set! changed #t
66f0: 29 0a 09 09 09 09 09 09 20 20 20 28 69 75 70 3a )....... (iup:
6700: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 attribute-set! s
6710: 74 61 74 73 2d 6d 61 74 72 69 78 20 6b 65 79 20 tats-matrix key
6720: 6e 61 6d 65 29 29 29 29 29 0a 09 09 09 09 09 20 name)))))......
6730: 72 6f 77 2d 69 6e 64 69 63 65 73 29 0a 0a 09 09 row-indices)....
6740: 09 20 20 20 20 20 20 20 3b 3b 20 43 6f 6c 20 6c . ;; Col l
6750: 61 62 65 6c 73 0a 09 09 09 20 20 20 20 20 20 20 abels....
6760: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
6770: 61 20 28 69 6e 64 29 0a 09 09 09 09 09 20 20 20 a (ind)......
6780: 28 6c 65 74 2a 20 28 28 6e 61 6d 65 20 28 63 61 (let* ((name (ca
6790: 72 20 69 6e 64 29 29 0a 09 09 09 09 09 09 20 20 r ind)).......
67a0: 28 6e 75 6d 20 20 28 63 61 64 72 20 69 6e 64 29 (num (cadr ind)
67b0: 29 0a 09 09 09 09 09 09 20 20 28 6b 65 79 20 20 )....... (key
67c0: 28 63 6f 6e 63 20 22 30 3a 22 20 6e 75 6d 29 29 (conc "0:" num))
67d0: 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 )...... (if
67e0: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 69 75 (not (equal? (iu
67f0: 70 3a 61 74 74 72 69 62 75 74 65 20 73 74 61 74 p:attribute stat
6800: 73 2d 6d 61 74 72 69 78 20 6b 65 79 29 20 6e 61 s-matrix key) na
6810: 6d 65 29 29 0a 09 09 09 09 09 09 20 28 62 65 67 me))....... (beg
6820: 69 6e 0a 09 09 09 09 09 09 20 20 20 28 73 65 74 in....... (set
6830: 21 20 63 68 61 6e 67 65 64 20 23 74 29 0a 09 09 ! changed #t)...
6840: 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 74 72 .... (iup:attr
6850: 69 62 75 74 65 2d 73 65 74 21 20 73 74 61 74 73 ibute-set! stats
6860: 2d 6d 61 74 72 69 78 20 6b 65 79 20 6e 61 6d 65 -matrix key name
6870: 29 29 29 29 29 0a 09 09 09 09 09 20 63 6f 6c 2d )))))...... col-
6880: 69 6e 64 69 63 65 73 29 0a 0a 09 09 09 20 20 20 indices).....
6890: 20 20 20 20 3b 3b 20 43 65 6c 6c 20 63 6f 6e 74 ;; Cell cont
68a0: 65 6e 74 73 0a 09 09 09 20 20 20 20 20 20 20 28 ents.... (
68b0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
68c0: 20 28 65 6e 74 72 79 29 0a 09 09 09 09 09 20 20 (entry)......
68d0: 20 28 6c 65 74 2a 20 28 28 72 6f 77 2d 6e 61 6d (let* ((row-nam
68e0: 65 20 28 63 61 72 20 65 6e 74 72 79 29 29 0a 09 e (car entry))..
68f0: 09 09 09 09 09 20 20 28 63 6f 6c 2d 6e 61 6d 65 ..... (col-name
6900: 20 28 63 61 64 72 20 65 6e 74 72 79 29 29 0a 09 (cadr entry))..
6910: 09 09 09 09 09 20 20 28 76 61 6c 75 65 20 20 20 ..... (value
6920: 20 28 63 61 64 64 72 20 65 6e 74 72 79 29 29 0a (caddr entry)).
6930: 09 09 09 09 09 09 20 20 28 72 6f 77 2d 6e 75 6d ...... (row-num
6940: 20 20 28 63 61 64 72 20 28 61 73 73 6f 63 20 72 (cadr (assoc r
6950: 6f 77 2d 6e 61 6d 65 20 72 6f 77 2d 69 6e 64 69 ow-name row-indi
6960: 63 65 73 29 29 29 0a 09 09 09 09 09 09 20 20 28 ces)))....... (
6970: 63 6f 6c 2d 6e 75 6d 20 20 28 63 61 64 72 20 28 col-num (cadr (
6980: 61 73 73 6f 63 20 63 6f 6c 2d 6e 61 6d 65 20 63 assoc col-name c
6990: 6f 6c 2d 69 6e 64 69 63 65 73 29 29 29 0a 09 09 ol-indices)))...
69a0: 09 09 09 09 20 20 28 6b 65 79 20 20 20 20 20 20 .... (key
69b0: 28 63 6f 6e 63 20 72 6f 77 2d 6e 75 6d 20 22 3a (conc row-num ":
69c0: 22 20 63 6f 6c 2d 6e 75 6d 29 29 29 0a 09 09 09 " col-num)))....
69d0: 09 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 .. (if (not
69e0: 28 65 71 75 61 6c 3f 20 28 69 75 70 3a 61 74 74 (equal? (iup:att
69f0: 72 69 62 75 74 65 20 73 74 61 74 73 2d 6d 61 74 ribute stats-mat
6a00: 72 69 78 20 6b 65 79 29 20 76 61 6c 75 65 29 29 rix key) value))
6a10: 0a 09 09 09 09 09 09 20 28 62 65 67 69 6e 0a 09 ....... (begin..
6a20: 09 09 09 09 09 20 20 20 28 73 65 74 21 20 63 68 ..... (set! ch
6a30: 61 6e 67 65 64 20 23 74 29 0a 09 09 09 09 09 09 anged #t).......
6a40: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
6a50: 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d 61 74 e-set! stats-mat
6a60: 72 69 78 20 6b 65 79 20 76 61 6c 75 65 29 29 29 rix key value)))
6a70: 29 29 0a 09 09 09 09 09 20 72 75 6e 2d 73 74 61 ))...... run-sta
6a80: 74 73 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 ts).... (i
6a90: 66 20 63 68 61 6e 67 65 64 20 28 69 75 70 3a 61 f changed (iup:a
6aa0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 ttribute-set! st
6ab0: 61 74 73 2d 6d 61 74 72 69 78 20 22 52 45 44 52 ats-matrix "REDR
6ac0: 41 57 22 20 22 41 4c 4c 22 29 29 29 0a 20 20 20 AW" "ALL"))).
6ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ae0: 20 20 20 20 20 20 20 20 20 20 29 29 29 29 0a 20 )))).
6af0: 20 20 20 3b 3b 20 28 64 62 6f 61 72 64 3a 63 6f ;; (dboard:co
6b00: 6d 6d 6f 6e 64 61 74 2d 70 6c 65 61 73 65 2d 75 mmondat-please-u
6b10: 70 64 61 74 65 2d 73 65 74 21 20 63 6f 6d 6d 6f pdate-set! commo
6b20: 6e 64 61 74 20 23 74 29 20 3b 3b 20 66 6f 72 63 ndat #t) ;; forc
6b30: 65 20 72 65 64 72 61 77 20 6f 6e 20 66 69 72 73 e redraw on firs
6b40: 74 20 70 61 73 73 20 0a 20 20 20 20 3b 3b 20 28 t pass . ;; (
6b50: 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65 20 mark-for-update
6b60: 74 61 62 64 61 74 29 0a 20 20 20 20 3b 3b 20 28 tabdat). ;; (
6b70: 73 74 61 74 73 2d 75 70 64 61 74 65 72 29 0a 20 stats-updater).
6b80: 20 20 20 28 64 62 6f 61 72 64 3a 63 6f 6d 6d 6f (dboard:commo
6b90: 6e 64 61 74 2d 61 64 64 2d 75 70 64 61 74 65 72 ndat-add-updater
6ba0: 20 63 6f 6d 6d 6f 6e 64 61 74 20 73 74 61 74 73 commondat stats
6bb0: 2d 75 70 64 61 74 65 72 20 74 61 62 2d 6e 75 6d -updater tab-num
6bc0: 3a 20 74 61 62 2d 6e 75 6d 29 0a 20 20 20 20 3b : tab-num). ;
6bd0: 3b 20 28 73 65 74 21 20 64 61 73 68 62 6f 61 72 ; (set! dashboar
6be0: 64 3a 75 70 64 61 74 65 2d 73 75 6d 6d 61 72 79 d:update-summary
6bf0: 2d 74 61 62 20 75 70 64 61 74 65 72 29 0a 20 20 -tab updater).
6c00: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 (iup:attribute
6c10: 2d 73 65 74 21 20 73 74 61 74 73 2d 6d 61 74 72 -set! stats-matr
6c20: 69 78 20 22 57 49 44 54 48 44 45 46 22 20 22 34 ix "WIDTHDEF" "4
6c30: 30 22 29 0a 20 20 20 20 28 69 75 70 3a 76 62 6f 0"). (iup:vbo
6c40: 78 0a 20 20 20 20 20 3b 3b 20 28 69 75 70 3a 6c x. ;; (iup:l
6c50: 61 62 65 6c 20 22 52 75 6e 20 73 74 61 74 69 73 abel "Run statis
6c60: 74 69 63 73 22 20 20 23 3a 65 78 70 61 6e 64 20 tics" #:expand
6c70: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 20 20 "HORIZONTAL").
6c80: 20 20 20 73 74 61 74 73 2d 6d 61 74 72 69 78 29 stats-matrix)
6c90: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 6f ))..(define (dco
6ca0: 6d 6d 6f 6e 3a 73 65 72 76 65 72 73 2d 74 61 62 mmon:servers-tab
6cb0: 6c 65 20 63 6f 6d 6d 6f 6e 64 61 74 20 74 61 62 le commondat tab
6cc0: 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 dat). (let* ((c
6cd0: 6f 6c 6e 75 6d 20 20 20 20 20 20 20 20 20 30 29 olnum 0)
6ce0: 0a 09 20 28 72 6f 77 6e 75 6d 20 20 20 20 20 20 .. (rownum
6cf0: 20 20 20 30 29 0a 09 20 28 73 65 72 76 65 72 73 0).. (servers
6d00: 2d 6d 61 74 72 69 78 20 28 69 75 70 3a 6d 61 74 -matrix (iup:mat
6d10: 72 69 78 20 23 3a 65 78 70 61 6e 64 20 22 59 45 rix #:expand "YE
6d20: 53 22 0a 09 09 09 09 20 20 20 20 20 23 3a 6e 75 S"..... #:nu
6d30: 6d 63 6f 6c 20 37 0a 09 09 09 09 20 20 20 20 20 mcol 7.....
6d40: 23 3a 6e 75 6d 63 6f 6c 2d 76 69 73 69 62 6c 65 #:numcol-visible
6d50: 20 37 0a 09 09 09 09 20 20 20 20 20 23 3a 6e 75 7..... #:nu
6d60: 6d 6c 69 6e 2d 76 69 73 69 62 6c 65 20 35 0a 09 mlin-visible 5..
6d70: 09 09 09 20 20 20 20 20 29 29 0a 09 20 28 63 6f ... )).. (co
6d80: 6c 6e 61 6d 65 73 20 20 20 20 20 20 20 28 6c 69 lnames (li
6d90: 73 74 20 22 49 64 22 20 22 4d 54 76 65 72 22 20 st "Id" "MTver"
6da0: 22 50 69 64 22 20 22 48 6f 73 74 22 20 22 49 6e "Pid" "Host" "In
6db0: 74 65 72 66 61 63 65 3a 4f 75 74 50 6f 72 74 22 terface:OutPort"
6dc0: 20 22 52 75 6e 54 69 6d 65 22 20 22 53 74 61 74 "RunTime" "Stat
6dd0: 65 22 20 22 52 75 6e 49 64 22 29 29 0a 09 20 28 e" "RunId")).. (
6de0: 75 70 64 61 74 65 72 20 20 20 20 20 20 20 20 28 updater (
6df0: 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 lambda ()....
6e00: 28 69 66 20 28 64 61 73 68 62 6f 61 72 64 3a 6d (if (dashboard:m
6e10: 6f 6e 69 74 6f 72 2d 63 68 61 6e 67 65 64 3f 20 onitor-changed?
6e20: 63 6f 6d 6d 6f 6e 64 61 74 20 74 61 62 64 61 74 commondat tabdat
6e30: 29 0a 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 ).... (let
6e40: 20 28 28 73 65 72 76 65 72 73 20 20 28 73 65 72 ((servers (ser
6e50: 76 65 72 3a 67 65 74 2d 6c 69 73 74 20 2a 74 6f ver:get-list *to
6e60: 70 70 61 74 68 2a 20 6c 69 6d 69 74 3a 20 31 30 ppath* limit: 10
6e70: 29 29 29 0a 09 09 09 09 20 28 69 75 70 3a 61 74 )))..... (iup:at
6e80: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 72 tribute-set! ser
6e90: 76 65 72 73 2d 6d 61 74 72 69 78 20 22 4e 55 4d vers-matrix "NUM
6ea0: 4c 49 4e 22 20 28 6c 65 6e 67 74 68 20 73 65 72 LIN" (length ser
6eb0: 76 65 72 73 29 29 0a 09 09 09 09 20 3b 3b 20 28 vers))..... ;; (
6ec0: 73 65 74 21 20 63 6f 6c 6e 75 6d 20 30 29 0a 09 set! colnum 0)..
6ed0: 09 09 09 20 3b 3b 20 28 66 6f 72 2d 65 61 63 68 ... ;; (for-each
6ee0: 20 28 6c 61 6d 62 64 61 20 28 63 6f 6c 6e 61 6d (lambda (colnam
6ef0: 65 29 0a 09 09 09 09 20 3b 3b 20 20 20 20 09 20 e)..... ;; .
6f00: 3b 3b 20 28 70 72 69 6e 74 20 22 63 6f 6c 6e 75 ;; (print "colnu
6f10: 6d 3a 20 22 20 63 6f 6c 6e 75 6d 20 22 20 63 6f m: " colnum " co
6f20: 6c 6e 61 6d 65 3a 20 22 20 63 6f 6c 6e 61 6d 65 lname: " colname
6f30: 29 0a 09 09 09 09 20 3b 3b 20 20 20 20 09 20 28 )..... ;; . (
6f40: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
6f50: 74 21 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69 t! servers-matri
6f60: 78 20 28 63 6f 6e 63 20 22 30 3a 22 20 63 6f 6c x (conc "0:" col
6f70: 6e 75 6d 29 20 63 6f 6c 6e 61 6d 65 29 0a 09 09 num) colname)...
6f80: 09 09 20 3b 3b 20 20 20 20 09 20 28 73 65 74 21 .. ;; . (set!
6f90: 20 63 6f 6c 6e 75 6d 20 28 2b 20 31 20 63 6f 6c colnum (+ 1 col
6fa0: 6e 75 6d 29 29 29 0a 09 09 09 09 20 3b 3b 20 20 num)))..... ;;
6fb0: 20 20 20 20 20 20 20 20 20 63 6f 6c 6e 61 6d 65 colname
6fc0: 73 29 0a 09 09 09 09 20 28 73 65 74 21 20 72 6f s)..... (set! ro
6fd0: 77 6e 75 6d 20 31 29 0a 09 09 09 09 20 28 66 6f wnum 1)..... (fo
6fe0: 72 2d 65 61 63 68 20 0a 09 09 09 09 20 20 28 6c r-each ..... (l
6ff0: 61 6d 62 64 61 20 28 73 65 72 76 65 72 29 0a 09 ambda (server)..
7000: 09 09 09 20 20 20 20 28 73 65 74 21 20 63 6f 6c ... (set! col
7010: 6e 75 6d 20 30 29 0a 09 09 09 09 20 20 20 20 28 num 0)..... (
7020: 6d 61 74 63 68 2d 6c 65 74 20 28 28 28 6d 6f 64 match-let (((mod
7030: 2d 74 69 6d 65 20 68 6f 73 74 20 70 6f 72 74 20 -time host port
7040: 73 74 61 72 74 2d 74 69 6d 65 20 70 69 64 29 0a start-time pid).
7050: 09 09 09 09 09 09 20 73 65 72 76 65 72 29 29 0a ...... server)).
7060: 09 09 09 09 20 20 20 20 20 20 28 6c 65 74 2a 20 .... (let*
7070: 28 28 75 70 74 69 6d 65 20 20 28 2d 20 28 63 75 ((uptime (- (cu
7080: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 6d rrent-seconds) m
7090: 6f 64 2d 74 69 6d 65 29 29 0a 09 09 09 09 09 20 od-time))......
70a0: 20 20 20 20 28 72 75 6e 74 69 6d 65 20 28 69 66 (runtime (if
70b0: 20 73 74 61 72 74 2d 74 69 6d 65 0a 09 09 09 09 start-time.....
70c0: 09 09 09 20 20 28 2d 20 6d 6f 64 2d 74 69 6d 65 ... (- mod-time
70d0: 20 73 74 61 72 74 2d 74 69 6d 65 29 0a 09 09 09 start-time)....
70e0: 09 09 09 09 20 20 30 29 29 0a 09 09 09 09 09 20 .... 0))......
70f0: 20 20 20 20 28 76 61 6c 73 20 28 6c 69 73 74 20 (vals (list
7100: 22 2d 22 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d "-" ;; (vector-
7110: 72 65 66 20 73 65 72 76 65 72 20 30 29 20 3b 3b ref server 0) ;;
7120: 20 49 64 0a 09 09 09 09 09 09 09 20 22 2d 22 20 Id........ "-"
7130: 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ;; (vector-ref
7140: 73 65 72 76 65 72 20 39 29 20 3b 3b 20 4d 54 2d server 9) ;; MT-
7150: 56 65 72 0a 09 09 09 09 09 09 09 20 70 69 64 20 Ver........ pid
7160: 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ;; (vector-ref
7170: 73 65 72 76 65 72 20 31 29 20 3b 3b 20 50 69 64 server 1) ;; Pid
7180: 0a 09 09 09 09 09 09 09 20 68 6f 73 74 20 3b 3b ........ host ;;
7190: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 (vector-ref ser
71a0: 76 65 72 20 32 29 20 3b 3b 20 48 6f 73 74 6e 61 ver 2) ;; Hostna
71b0: 6d 65 0a 09 09 09 09 09 09 09 20 28 63 6f 6e 63 me........ (conc
71c0: 20 68 6f 73 74 20 22 3a 22 20 70 6f 72 74 29 20 host ":" port)
71d0: 3b 3b 20 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 ;; (conc (vector
71e0: 2d 72 65 66 20 73 65 72 76 65 72 20 33 29 20 22 -ref server 3) "
71f0: 3a 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 :" (vector-ref s
7200: 65 72 76 65 72 20 34 29 29 20 3b 3b 20 49 50 3a erver 4)) ;; IP:
7210: 50 6f 72 74 0a 09 09 09 09 09 09 09 20 28 73 65 Port........ (se
7220: 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73 65 conds->hr-min-se
7230: 63 20 72 75 6e 74 69 6d 65 29 20 3b 3b 20 28 2d c runtime) ;; (-
7240: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
7250: 73 29 20 73 74 61 72 74 2d 74 69 6d 65 29 29 20 s) start-time))
7260: 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 ;; (vector-ref s
7270: 65 72 76 65 72 20 36 29 29 29 0a 09 09 09 09 09 erver 6)))......
7280: 09 09 20 28 63 6f 6e 64 0a 09 09 09 09 09 09 09 .. (cond........
7290: 20 20 28 28 3c 20 75 70 74 69 6d 65 20 35 29 20 ((< uptime 5)
72a0: 20 22 61 6c 69 76 65 22 29 0a 09 09 09 09 09 09 "alive").......
72b0: 09 20 20 28 28 3c 20 75 70 74 69 6d 65 20 31 36 . ((< uptime 16
72c0: 29 20 22 70 72 6f 62 61 62 6c 79 20 61 6c 69 76 ) "probably aliv
72d0: 65 22 29 3b 3b 20 6c 65 73 73 20 74 68 61 6e 20 e");; less than
72e0: 31 35 20 73 65 63 6f 6e 64 73 20 73 69 6e 63 65 15 seconds since
72f0: 20 6d 6f 64 2c 20 63 61 6c 6c 20 69 74 20 61 6c mod, call it al
7300: 69 76 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ive (vector-ref
7310: 73 65 72 76 65 72 20 38 29 20 3b 3b 20 53 74 61 server 8) ;; Sta
7320: 74 65 0a 09 09 09 09 09 09 09 20 20 28 65 6c 73 te........ (els
7330: 65 20 22 64 65 61 64 22 29 29 0a 09 09 09 09 09 e "dead"))......
7340: 09 09 20 22 2d 22 20 3b 3b 20 28 76 65 63 74 6f .. "-" ;; (vecto
7350: 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 32 29 r-ref server 12)
7360: 20 20 3b 3b 20 52 75 6e 49 64 0a 09 09 09 09 09 ;; RunId......
7370: 09 09 20 29 29 29 0a 09 09 09 09 09 28 66 6f 72 .. )))......(for
7380: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 76 -each (lambda (v
7390: 61 6c 29 0a 09 09 09 09 09 09 20 20 20 20 28 6c al)....... (l
73a0: 65 74 2a 20 28 28 72 6f 77 2d 63 6f 6c 20 28 63 et* ((row-col (c
73b0: 6f 6e 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20 63 onc rownum ":" c
73c0: 6f 6c 6e 75 6d 29 29 0a 09 09 09 09 09 09 09 20 olnum))........
73d0: 20 20 28 63 75 72 72 2d 76 61 6c 20 28 69 75 70 (curr-val (iup
73e0: 3a 61 74 74 72 69 62 75 74 65 20 73 65 72 76 65 :attribute serve
73f0: 72 73 2d 6d 61 74 72 69 78 20 72 6f 77 2d 63 6f rs-matrix row-co
7400: 6c 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 l))).......
7410: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
7420: 3f 20 28 63 6f 6e 63 20 76 61 6c 29 20 63 75 72 ? (conc val) cur
7430: 72 2d 76 61 6c 29 29 0a 09 09 09 09 09 09 09 20 r-val))........
7440: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 20 (begin........
7450: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
7460: 65 2d 73 65 74 21 20 73 65 72 76 65 72 73 2d 6d e-set! servers-m
7470: 61 74 72 69 78 20 72 6f 77 2d 63 6f 6c 20 76 61 atrix row-col va
7480: 6c 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 69 l)........ (i
7490: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
74a0: 21 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69 78 ! servers-matrix
74b0: 20 22 46 49 54 54 4f 54 45 58 54 22 20 28 63 6f "FITTOTEXT" (co
74c0: 6e 63 20 22 43 22 20 63 6f 6c 6e 75 6d 29 29 29 nc "C" colnum)))
74d0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 73 )....... (s
74e0: 65 74 21 20 63 6f 6c 6e 75 6d 20 28 2b 20 31 20 et! colnum (+ 1
74f0: 63 6f 6c 6e 75 6d 29 29 29 29 0a 09 09 09 09 09 colnum))))......
7500: 09 20 20 76 61 6c 73 29 0a 09 09 09 09 09 28 73 . vals)......(s
7510: 65 74 21 20 72 6f 77 6e 75 6d 20 28 2b 20 72 6f et! rownum (+ ro
7520: 77 6e 75 6d 20 31 29 29 29 0a 09 09 09 09 20 20 wnum 1))).....
7530: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
7540: 74 65 2d 73 65 74 21 20 73 65 72 76 65 72 73 2d te-set! servers-
7550: 6d 61 74 72 69 78 20 22 52 45 44 52 41 57 22 20 matrix "REDRAW"
7560: 22 41 4c 4c 22 29 29 29 0a 09 09 09 09 20 20 20 "ALL"))).....
7570: 20 28 73 6f 72 74 20 73 65 72 76 65 72 73 20 28 (sort servers (
7580: 6c 61 6d 62 64 61 20 28 61 20 62 29 28 3e 20 28 lambda (a b)(> (
7590: 63 61 72 20 61 29 28 63 61 72 20 62 29 29 29 29 car a)(car b))))
75a0: 29 29 29 29 29 29 0a 20 20 20 20 28 73 65 74 21 )))))). (set!
75b0: 20 63 6f 6c 6e 75 6d 20 30 29 0a 20 20 20 20 28 colnum 0). (
75c0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
75d0: 20 28 63 6f 6c 6e 61 6d 65 29 0a 09 09 28 69 75 (colname)...(iu
75e0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
75f0: 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69 78 20 servers-matrix
7600: 28 63 6f 6e 63 20 22 30 3a 22 20 63 6f 6c 6e 75 (conc "0:" colnu
7610: 6d 29 20 63 6f 6c 6e 61 6d 65 29 0a 09 09 28 69 m) colname)...(i
7620: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
7630: 21 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69 78 ! servers-matrix
7640: 20 22 46 49 54 54 4f 54 45 58 54 22 20 28 63 6f "FITTOTEXT" (co
7650: 6e 63 20 22 43 22 20 63 6f 6c 6e 75 6d 29 29 0a nc "C" colnum)).
7660: 09 09 28 73 65 74 21 20 63 6f 6c 6e 75 6d 20 28 ..(set! colnum (
7670: 2b 20 63 6f 6c 6e 75 6d 20 31 29 29 29 0a 09 20 + colnum 1)))..
7680: 20 20 20 20 20 63 6f 6c 6e 61 6d 65 73 29 0a 20 colnames).
7690: 20 20 20 3b 3b 20 28 73 65 74 21 20 64 61 73 68 ;; (set! dash
76a0: 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 73 65 72 board:update-ser
76b0: 76 65 72 73 2d 74 61 62 6c 65 20 75 70 64 61 74 vers-table updat
76c0: 65 72 29 20 0a 20 20 20 20 28 64 62 6f 61 72 64 er) . (dboard
76d0: 3a 63 6f 6d 6d 6f 6e 64 61 74 2d 61 64 64 2d 75 :commondat-add-u
76e0: 70 64 61 74 65 72 20 63 6f 6d 6d 6f 6e 64 61 74 pdater commondat
76f0: 20 75 70 64 61 74 65 72 29 0a 20 20 20 20 3b 3b updater). ;;
7700: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
7710: 73 65 74 21 20 73 65 72 76 65 72 73 2d 6d 61 74 set! servers-mat
7720: 72 69 78 20 22 57 49 44 54 48 44 45 46 22 20 22 rix "WIDTHDEF" "
7730: 34 30 22 29 0a 20 20 20 20 3b 3b 20 20 28 69 75 40"). ;; (iu
7740: 70 3a 68 62 6f 78 0a 20 20 20 20 3b 3b 20 20 20 p:hbox. ;;
7750: 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 20 3b 3b (iup:vbox. ;;
7760: 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 (iup:button
7770: 22 53 74 61 72 74 22 0a 20 20 20 20 3b 3b 20 20 "Start". ;;
7780: 20 20 20 20 09 20 20 3b 3b 20 23 3a 73 69 7a 65 . ;; #:size
7790: 20 22 35 30 78 22 0a 20 20 20 20 3b 3b 20 20 20 "50x". ;;
77a0: 20 20 20 09 20 20 23 3a 65 78 70 61 6e 64 20 22 . #:expand "
77b0: 59 45 53 22 0a 20 20 20 20 3b 3b 20 20 20 20 20 YES". ;;
77c0: 20 09 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 . #:action (la
77d0: 6d 62 64 61 20 28 6f 62 6a 29 0a 20 20 20 20 3b mbda (obj). ;
77e0: 3b 20 20 20 20 20 20 09 09 20 20 20 20 20 28 6c ; .. (l
77f0: 65 74 20 28 28 63 6d 64 20 28 63 6f 6e 63 20 3b et ((cmd (conc ;
7800: 3b 20 22 78 74 65 72 6d 20 2d 67 65 6f 6d 65 74 ; "xterm -geomet
7810: 72 79 20 31 38 30 78 32 30 20 2d 65 20 5c 22 22 ry 180x20 -e \""
7820: 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09 09 . ;; ...
7830: 09 20 20 20 20 20 20 22 6d 65 67 61 74 65 73 74 . "megatest
7840: 20 2d 73 65 72 76 65 72 20 2d 20 26 22 29 29 29 -server - &")))
7850: 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09 09 . ;; ...
7860: 09 20 20 20 20 20 20 3b 3b 20 22 3b 65 63 68 6f . ;; ";echo
7870: 20 50 72 65 73 73 20 61 6e 79 20 6b 65 79 20 74 Press any key t
7880: 6f 20 63 6f 6e 74 69 6e 75 65 3b 62 61 73 68 20 o continue;bash
7890: 2d 63 20 27 72 65 61 64 20 2d 6e 20 31 20 2d 73 -c 'read -n 1 -s
78a0: 27 5c 22 20 26 22 29 29 29 0a 20 20 20 20 3b 3b '\" &"))). ;;
78b0: 20 20 20 20 20 20 09 09 20 20 20 20 20 20 20 28 .. (
78c0: 73 79 73 74 65 6d 20 63 6d 64 29 29 29 29 0a 20 system cmd)))).
78d0: 20 20 20 3b 3b 20 20 20 20 28 69 75 70 3a 62 75 ;; (iup:bu
78e0: 74 74 6f 6e 20 22 53 74 6f 70 22 0a 20 20 20 20 tton "Stop".
78f0: 3b 3b 20 20 20 20 20 20 09 20 20 23 3a 65 78 70 ;; . #:exp
7900: 61 6e 64 20 22 59 45 53 22 0a 20 20 20 20 3b 3b and "YES". ;;
7910: 20 20 20 20 20 20 09 20 20 3b 3b 20 23 3a 73 69 . ;; #:si
7920: 7a 65 20 22 35 30 78 22 0a 20 20 20 20 3b 3b 20 ze "50x". ;;
7930: 20 20 20 20 20 09 20 20 23 3a 61 63 74 69 6f 6e . #:action
7940: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 20 (lambda (obj).
7950: 20 20 20 3b 3b 20 20 20 20 20 20 09 09 20 20 20 ;; ..
7960: 20 20 28 6c 65 74 20 28 28 63 6d 64 20 28 63 6f (let ((cmd (co
7970: 6e 63 20 3b 3b 20 22 78 74 65 72 6d 20 2d 67 65 nc ;; "xterm -ge
7980: 6f 6d 65 74 72 79 20 31 38 30 78 32 30 20 2d 65 ometry 180x20 -e
7990: 20 5c 22 22 0a 20 20 20 20 3b 3b 20 20 20 20 20 \"". ;;
79a0: 20 09 09 09 09 20 20 20 20 20 20 22 6d 65 67 61 .... "mega
79b0: 74 65 73 74 20 2d 73 74 6f 70 2d 73 65 72 76 65 test -stop-serve
79c0: 72 20 30 20 26 22 29 29 29 0a 20 20 20 20 3b 3b r 0 &"))). ;;
79d0: 20 20 20 20 20 20 09 09 09 09 20 20 20 20 20 20 ....
79e0: 3b 3b 20 22 3b 65 63 68 6f 20 50 72 65 73 73 20 ;; ";echo Press
79f0: 61 6e 79 20 6b 65 79 20 74 6f 20 63 6f 6e 74 69 any key to conti
7a00: 6e 75 65 3b 62 61 73 68 20 2d 63 20 27 72 65 61 nue;bash -c 'rea
7a10: 64 20 2d 6e 20 31 20 2d 73 27 5c 22 20 26 22 29 d -n 1 -s'\" &")
7a20: 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09 )). ;; .
7a30: 09 20 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 . (system
7a40: 63 6d 64 29 29 29 29 0a 20 20 20 20 3b 3b 20 20 cmd)))). ;;
7a50: 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22 52 (iup:button "R
7a60: 65 73 74 61 72 74 22 0a 20 20 20 20 3b 3b 20 20 estart". ;;
7a70: 20 20 20 20 09 20 20 23 3a 65 78 70 61 6e 64 20 . #:expand
7a80: 22 59 45 53 22 0a 20 20 20 20 3b 3b 20 20 20 20 "YES". ;;
7a90: 20 20 09 20 20 3b 3b 20 23 3a 73 69 7a 65 20 22 . ;; #:size "
7aa0: 35 30 78 22 0a 20 20 20 20 3b 3b 20 20 20 20 20 50x". ;;
7ab0: 20 09 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 . #:action (la
7ac0: 6d 62 64 61 20 28 6f 62 6a 29 0a 20 20 20 20 3b mbda (obj). ;
7ad0: 3b 20 20 20 20 20 20 09 09 20 20 20 20 20 28 6c ; .. (l
7ae0: 65 74 20 28 28 63 6d 64 20 28 63 6f 6e 63 20 3b et ((cmd (conc ;
7af0: 3b 20 22 78 74 65 72 6d 20 2d 67 65 6f 6d 65 74 ; "xterm -geomet
7b00: 72 79 20 31 38 30 78 32 30 20 2d 65 20 5c 22 22 ry 180x20 -e \""
7b10: 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09 09 . ;; ...
7b20: 09 20 20 20 20 20 20 22 6d 65 67 61 74 65 73 74 . "megatest
7b30: 20 2d 73 74 6f 70 2d 73 65 72 76 65 72 20 30 3b -stop-server 0;
7b40: 6d 65 67 61 74 65 73 74 20 2d 73 65 72 76 65 72 megatest -server
7b50: 20 2d 20 26 22 29 29 29 0a 20 20 20 20 3b 3b 20 - &"))). ;;
7b60: 20 20 20 20 20 09 09 09 09 20 20 20 20 20 20 3b .... ;
7b70: 3b 20 22 3b 65 63 68 6f 20 50 72 65 73 73 20 61 ; ";echo Press a
7b80: 6e 79 20 6b 65 79 20 74 6f 20 63 6f 6e 74 69 6e ny key to contin
7b90: 75 65 3b 62 61 73 68 20 2d 63 20 27 72 65 61 64 ue;bash -c 'read
7ba0: 20 2d 6e 20 31 20 2d 73 27 5c 22 20 26 22 29 29 -n 1 -s'\" &"))
7bb0: 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09 ). ;; ..
7bc0: 20 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 63 (system c
7bd0: 6d 64 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 20 md))))). ;;
7be0: 20 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69 78 servers-matrix
7bf0: 0a 20 20 20 20 3b 3b 20 20 20 29 29 29 0a 20 20 . ;; ))).
7c00: 20 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69 78 servers-matrix
7c10: 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 54 68 65 20 . ))..;; The
7c20: 6d 61 69 6e 20 6d 65 6e 75 0a 28 64 65 66 69 6e main menu.(defin
7c30: 65 20 28 64 63 6f 6d 6d 6f 6e 3a 6d 61 69 6e 2d e (dcommon:main-
7c40: 6d 65 6e 75 29 0a 20 20 28 69 75 70 3a 6d 65 6e menu). (iup:men
7c50: 75 20 3b 3b 20 61 20 6d 65 6e 75 20 69 73 20 61 u ;; a menu is a
7c60: 20 73 70 65 63 69 61 6c 20 61 74 74 72 69 62 75 special attribu
7c70: 74 65 20 74 6f 20 61 20 64 69 61 6c 6f 67 20 28 te to a dialog (
7c80: 74 68 69 6e 6b 20 47 6e 6f 6d 65 20 70 75 74 74 think Gnome putt
7c90: 69 6e 67 20 74 68 65 20 6d 65 6e 75 20 61 74 20 ing the menu at
7ca0: 73 63 72 65 65 6e 20 74 6f 70 29 0a 20 20 20 28 screen top). (
7cb0: 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 46 iup:menu-item "F
7cc0: 69 6c 65 73 22 20 28 69 75 70 3a 6d 65 6e 75 20 iles" (iup:menu
7cd0: 20 20 3b 3b 20 4e 6f 74 65 20 74 68 61 74 20 79 ;; Note that y
7ce0: 6f 75 20 63 61 6e 20 75 73 65 20 65 69 74 68 65 ou can use eithe
7cf0: 72 20 23 3a 61 63 74 69 6f 6e 20 6f 72 20 61 63 r #:action or ac
7d00: 74 69 6f 6e 3a 20 66 6f 72 20 6f 70 74 69 6f 6e tion: for option
7d10: 73 0a 09 09 09 20 20 20 28 69 75 70 3a 6d 65 6e s.... (iup:men
7d20: 75 2d 69 74 65 6d 20 22 4f 70 65 6e 22 20 20 61 u-item "Open" a
7d30: 63 74 69 6f 6e 3a 20 28 6c 61 6d 62 64 61 20 28 ction: (lambda (
7d40: 6f 62 6a 29 0a 09 09 09 09 09 09 09 20 20 20 20 obj)........
7d50: 28 6c 65 74 2a 20 28 28 61 72 65 61 2d 6e 61 6d (let* ((area-nam
7d60: 65 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20 23 e (iup:textbox #
7d70: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
7d80: 54 41 4c 22 29 29 0a 09 09 09 09 09 09 09 09 20 TAL")).........
7d90: 20 20 28 66 64 20 20 20 20 20 20 20 20 28 69 75 (fd (iu
7da0: 70 3a 66 69 6c 65 2d 64 69 61 6c 6f 67 20 23 3a p:file-dialog #:
7db0: 64 69 61 6c 6f 67 74 79 70 65 20 22 44 49 52 22 dialogtype "DIR"
7dc0: 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 74 ))......... (t
7dd0: 6f 70 20 20 20 20 20 20 20 28 69 75 70 3a 73 68 op (iup:sh
7de0: 6f 77 20 66 64 20 23 3a 6d 6f 64 61 6c 3f 20 22 ow fd #:modal? "
7df0: 59 45 53 22 29 29 29 0a 09 09 09 09 09 09 09 20 YES")))........
7e00: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
7e10: 75 74 65 2d 73 65 74 21 20 73 6f 75 72 63 65 2d ute-set! source-
7e20: 74 62 20 22 56 41 4c 55 45 22 0a 09 09 09 09 09 tb "VALUE"......
7e30: 09 09 09 09 09 20 20 28 69 75 70 3a 61 74 74 72 ..... (iup:attr
7e40: 69 62 75 74 65 20 66 64 20 22 56 41 4c 55 45 22 ibute fd "VALUE"
7e50: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 ))........
7e60: 28 69 75 70 3a 64 65 73 74 72 6f 79 21 20 66 64 (iup:destroy! fd
7e70: 29 29 29 29 0a 09 09 09 20 20 20 3b 3b 20 28 6c )))).... ;; (l
7e80: 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 20 ambda (obj)....
7e90: 20 20 3b 3b 20 20 28 69 75 70 3a 73 68 6f 77 20 ;; (iup:show
7ea0: 28 69 75 70 3a 66 69 6c 65 2d 64 69 61 6c 6f 67 (iup:file-dialog
7eb0: 29 29 0a 09 09 09 20 20 20 3b 3b 20 20 28 70 72 )).... ;; (pr
7ec0: 69 6e 74 20 22 46 69 6c 65 2d 3e 6f 70 65 6e 20 int "File->open
7ed0: 22 20 6f 62 6a 29 29 29 0a 09 09 09 20 20 20 28 " obj))).... (
7ee0: 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 53 iup:menu-item "S
7ef0: 61 76 65 22 20 20 23 3a 61 63 74 69 6f 6e 20 28 ave" #:action (
7f00: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 70 72 69 lambda (obj)(pri
7f10: 6e 74 20 22 46 69 6c 65 2d 3e 73 61 76 65 20 22 nt "File->save "
7f20: 20 6f 62 6a 29 29 29 0a 09 09 09 20 20 20 28 69 obj))).... (i
7f30: 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 45 78 up:menu-item "Ex
7f40: 69 74 22 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c it" #:action (l
7f50: 61 6d 62 64 61 20 28 6f 62 6a 29 28 65 78 69 74 ambda (obj)(exit
7f60: 29 29 29 29 29 0a 20 20 20 28 69 75 70 3a 6d 65 ))))). (iup:me
7f70: 6e 75 2d 69 74 65 6d 20 22 54 6f 6f 6c 73 22 20 nu-item "Tools"
7f80: 28 69 75 70 3a 6d 65 6e 75 0a 09 09 09 20 20 20 (iup:menu....
7f90: 28 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 (iup:menu-item "
7fa0: 43 72 65 61 74 65 20 6e 65 77 20 62 6c 61 68 22 Create new blah"
7fb0: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
7fc0: 61 20 28 6f 62 6a 29 28 70 72 69 6e 74 20 22 54 a (obj)(print "T
7fd0: 6f 6f 6c 73 2d 3e 6e 65 77 20 62 6c 61 68 22 29 ools->new blah")
7fe0: 29 29 0a 09 09 09 20 20 20 3b 3b 20 28 69 75 70 )).... ;; (iup
7ff0: 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 53 68 6f 77 :menu-item "Show
8000: 20 64 69 61 6c 6f 67 22 20 20 20 20 20 23 3a 61 dialog" #:a
8010: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
8020: 62 6a 29 0a 09 09 09 20 20 20 3b 3b 20 20 09 09 bj).... ;; ..
8030: 09 09 09 20 20 20 28 73 68 6f 77 20 6d 65 73 73 ... (show mess
8040: 61 67 65 2d 77 69 6e 64 6f 77 0a 09 09 09 20 20 age-window....
8050: 20 3b 3b 20 20 09 09 09 09 09 20 20 20 20 20 23 ;; ..... #
8060: 3a 6d 6f 64 61 6c 3f 20 23 74 0a 09 09 09 20 20 :modal? #t....
8070: 20 3b 3b 20 20 09 09 09 09 09 20 20 20 20 20 3b ;; ..... ;
8080: 3b 20 73 65 74 20 70 6f 73 69 74 6f 6e 20 75 73 ; set positon us
8090: 69 6e 67 20 63 6f 6f 72 64 69 6e 61 74 65 73 20 ing coordinates
80a0: 6f 72 20 63 65 6e 74 65 72 2c 20 73 74 61 72 74 or center, start
80b0: 2c 20 74 6f 70 2c 20 6c 65 66 74 2c 20 65 6e 64 , top, left, end
80c0: 2c 20 62 6f 74 74 6f 6d 2c 20 72 69 67 68 74 2c , bottom, right,
80d0: 20 70 61 72 65 6e 74 2d 63 65 6e 74 65 72 2c 20 parent-center,
80e0: 63 75 72 72 65 6e 74 0a 09 09 09 20 20 20 3b 3b current.... ;;
80f0: 20 20 09 09 09 09 09 20 20 20 20 20 3b 3b 20 23 ..... ;; #
8100: 3a 78 20 27 6d 6f 75 73 65 0a 09 09 09 20 20 20 :x 'mouse....
8110: 3b 3b 20 20 09 09 09 09 09 20 20 20 20 20 3b 3b ;; ..... ;;
8120: 20 23 3a 79 20 27 6d 6f 75 73 65 0a 09 09 09 20 #:y 'mouse....
8130: 20 20 3b 3b 20 20 29 09 09 09 09 09 20 20 20 20 ;; ).....
8140: 20 0a 09 09 09 20 20 20 29 29 29 29 0a 0a 3b 3b .... ))))..;;
8150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8190: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 41 4e 56 41 53 ======.;; CANVAS
81a0: 20 53 54 55 46 46 20 46 4f 52 20 54 45 53 54 53 STUFF FOR TESTS
81b0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
81c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
81d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
81e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
81f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
8200: 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 ne (dcommon:draw
8210: 2d 74 65 73 74 20 63 6e 76 20 78 6f 66 66 73 65 -test cnv xoffse
8220: 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c 65 66 t yoffset scalef
8230: 20 78 20 79 20 77 20 68 20 6e 61 6d 65 20 73 65 x y w h name se
8240: 6c 65 63 74 65 64 29 0a 20 20 28 6c 65 74 2a 20 lected). (let*
8250: 28 28 6c 6c 78 20 28 64 63 6f 6d 6d 6f 6e 3a 78 ((llx (dcommon:x
8260: 2d 3e 63 61 6e 76 61 73 20 78 20 73 63 61 6c 65 ->canvas x scale
8270: 66 20 78 6f 66 66 73 65 74 29 29 0a 09 20 28 6c f xoffset)).. (l
8280: 6c 79 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e 63 ly (dcommon:y->c
8290: 61 6e 76 61 73 20 79 20 73 63 61 6c 65 66 20 79 anvas y scalef y
82a0: 6f 66 66 73 65 74 29 29 0a 09 20 28 75 72 78 20 offset)).. (urx
82b0: 28 64 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 (dcommon:x->canv
82c0: 61 73 20 28 2b 20 78 20 77 29 20 73 63 61 6c 65 as (+ x w) scale
82d0: 66 20 78 6f 66 66 73 65 74 29 29 0a 09 20 28 75 f xoffset)).. (u
82e0: 72 79 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e 63 ry (dcommon:y->c
82f0: 61 6e 76 61 73 20 28 2b 20 79 20 68 29 20 73 63 anvas (+ y h) sc
8300: 61 6c 65 66 20 79 6f 66 66 73 65 74 29 29 29 0a alef yoffset))).
8310: 20 20 20 20 28 63 61 6e 76 61 73 2d 74 65 78 74 (canvas-text
8320: 21 20 63 6e 76 20 28 2b 20 6c 6c 78 20 35 29 28 ! cnv (+ llx 5)(
8330: 2b 20 6c 6c 79 20 35 29 20 6e 61 6d 65 29 0a 20 + lly 5) name).
8340: 20 20 20 28 63 61 6e 76 61 73 2d 72 65 63 74 61 (canvas-recta
8350: 6e 67 6c 65 21 20 63 6e 76 20 6c 6c 78 20 75 72 ngle! cnv llx ur
8360: 78 20 6c 6c 79 20 75 72 79 29 0a 20 20 20 20 28 x lly ury). (
8370: 69 66 20 73 65 6c 65 63 74 65 64 20 28 63 61 6e if selected (can
8380: 76 61 73 2d 62 6f 78 21 20 63 6e 76 20 6c 6c 78 vas-box! cnv llx
8390: 20 28 2b 20 6c 6c 78 20 35 29 20 6c 6c 79 20 28 (+ llx 5) lly (
83a0: 2b 20 6c 6c 79 20 35 29 29 29 29 29 0a 0a 28 64 + lly 5)))))..(d
83b0: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 64 efine (dcommon:d
83c0: 72 61 77 2d 61 72 72 6f 77 20 63 6e 76 20 74 65 raw-arrow cnv te
83d0: 73 74 2d 62 6f 78 2d 63 65 6e 74 65 72 20 77 61 st-box-center wa
83e0: 69 74 6f 6e 2d 63 65 6e 74 65 72 29 0a 20 20 28 iton-center). (
83f0: 6c 65 74 2a 20 28 28 74 65 73 74 2d 62 6f 78 2d let* ((test-box-
8400: 63 65 6e 74 65 72 2d 78 20 28 76 65 63 74 6f 72 center-x (vector
8410: 2d 72 65 66 20 74 65 73 74 2d 62 6f 78 2d 63 65 -ref test-box-ce
8420: 6e 74 65 72 20 30 29 29 0a 09 20 28 74 65 73 74 nter 0)).. (test
8430: 2d 62 6f 78 2d 63 65 6e 74 65 72 2d 79 20 28 76 -box-center-y (v
8440: 65 63 74 6f 72 2d 72 65 66 20 74 65 73 74 2d 62 ector-ref test-b
8450: 6f 78 2d 63 65 6e 74 65 72 20 31 29 29 0a 09 20 ox-center 1))..
8460: 28 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 2d 78 (waiton-center-x
8470: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 77 (vector-ref w
8480: 61 69 74 6f 6e 2d 63 65 6e 74 65 72 20 20 20 30 aiton-center 0
8490: 29 29 0a 09 20 28 77 61 69 74 6f 6e 2d 63 65 6e )).. (waiton-cen
84a0: 74 65 72 2d 79 20 20 20 28 76 65 63 74 6f 72 2d ter-y (vector-
84b0: 72 65 66 20 77 61 69 74 6f 6e 2d 63 65 6e 74 65 ref waiton-cente
84c0: 72 20 20 20 31 29 29 0a 09 20 28 64 65 6c 74 61 r 1)).. (delta
84d0: 2d 79 20 20 20 20 20 20 20 20 20 20 20 28 2d 20 -y (-
84e0: 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 2d 79 20 waiton-center-y
84f0: 74 65 73 74 2d 62 6f 78 2d 63 65 6e 74 65 72 2d test-box-center-
8500: 79 29 29 0a 09 20 28 64 65 6c 74 61 2d 78 20 20 y)).. (delta-x
8510: 20 20 20 20 20 20 20 20 20 28 2d 20 77 61 69 74 (- wait
8520: 6f 6e 2d 63 65 6e 74 65 72 2d 78 20 74 65 73 74 on-center-x test
8530: 2d 62 6f 78 2d 63 65 6e 74 65 72 2d 78 29 29 0a -box-center-x)).
8540: 09 20 28 61 62 73 2d 64 65 6c 74 61 2d 78 20 20 . (abs-delta-x
8550: 20 20 20 20 20 28 61 62 73 20 64 65 6c 74 61 2d (abs delta-
8560: 78 29 29 0a 09 20 28 61 62 73 2d 64 65 6c 74 61 x)).. (abs-delta
8570: 2d 79 20 20 20 20 20 20 20 28 61 62 73 20 64 65 -y (abs de
8580: 6c 74 61 2d 79 29 29 0a 09 20 28 75 73 65 2d 64 lta-y)).. (use-d
8590: 65 6c 74 61 2d 78 20 20 20 20 20 20 20 28 3e 20 elta-x (>
85a0: 61 62 73 2d 64 65 6c 74 61 2d 78 20 61 62 73 2d abs-delta-x abs-
85b0: 64 65 6c 74 61 2d 79 29 29 20 3b 3b 20 75 73 65 delta-y)) ;; use
85c0: 20 74 68 65 20 6c 61 72 67 65 72 20 6f 6e 65 0a the larger one.
85d0: 09 20 28 64 65 6c 74 61 2d 72 61 74 69 6f 20 20 . (delta-ratio
85e0: 20 20 20 20 20 28 69 66 20 75 73 65 2d 64 65 6c (if use-del
85f0: 74 61 2d 78 0a 09 09 09 09 28 69 66 20 28 3e 20 ta-x.....(if (>
8600: 61 62 73 2d 64 65 6c 74 61 2d 78 20 30 29 0a 09 abs-delta-x 0)..
8610: 09 09 09 20 20 20 20 28 2f 20 61 62 73 2d 64 65 ... (/ abs-de
8620: 6c 74 61 2d 79 20 61 62 73 2d 64 65 6c 74 61 2d lta-y abs-delta-
8630: 78 29 0a 09 09 09 09 20 20 20 20 31 29 0a 09 09 x)..... 1)...
8640: 09 09 28 69 66 20 28 3e 20 61 62 73 2d 64 65 6c ..(if (> abs-del
8650: 74 61 2d 79 20 30 29 0a 09 09 09 09 20 20 20 20 ta-y 0).....
8660: 28 2f 20 61 62 73 2d 64 65 6c 74 61 2d 78 20 61 (/ abs-delta-x a
8670: 62 73 2d 64 65 6c 74 61 2d 79 29 0a 09 09 09 09 bs-delta-y).....
8680: 20 20 20 20 31 29 29 29 0a 09 20 28 78 2d 61 64 1))).. (x-ad
8690: 6a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 j (i
86a0: 66 20 75 73 65 2d 64 65 6c 74 61 2d 78 0a 09 09 f use-delta-x...
86b0: 09 09 38 0a 09 09 09 09 28 2a 20 64 65 6c 74 61 ..8.....(* delta
86c0: 2d 72 61 74 69 6f 20 38 29 29 29 0a 09 20 28 79 -ratio 8))).. (y
86d0: 2d 61 64 6a 20 20 20 20 20 20 20 20 20 20 20 20 -adj
86e0: 20 28 69 66 20 75 73 65 2d 64 65 6c 74 61 2d 78 (if use-delta-x
86f0: 0a 09 09 09 09 28 2a 20 78 2d 61 64 6a 20 64 65 .....(* x-adj de
8700: 6c 74 61 2d 72 61 74 69 6f 29 0a 09 09 09 09 38 lta-ratio).....8
8710: 29 29 0a 09 20 28 6e 65 77 2d 77 61 69 74 6f 6e )).. (new-waiton
8720: 2d 78 20 20 20 20 20 20 28 69 6e 65 78 61 63 74 -x (inexact
8730: 2d 3e 65 78 61 63 74 0a 09 09 09 20 20 20 20 20 ->exact....
8740: 28 72 6f 75 6e 64 20 28 69 66 20 28 3e 20 64 65 (round (if (> de
8750: 6c 74 61 2d 78 20 30 29 20 3b 3b 20 68 61 76 65 lta-x 0) ;; have
8760: 20 70 6f 73 69 74 69 76 65 20 78 0a 09 09 09 09 positive x.....
8770: 09 28 2d 20 77 61 69 74 6f 6e 2d 63 65 6e 74 65 .(- waiton-cente
8780: 72 2d 78 20 78 2d 61 64 6a 29 0a 09 09 09 09 09 r-x x-adj)......
8790: 28 2b 20 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 (+ waiton-center
87a0: 2d 78 20 78 2d 61 64 6a 29 29 29 29 29 0a 09 20 -x x-adj)))))..
87b0: 28 6e 65 77 2d 77 61 69 74 6f 6e 2d 79 20 20 20 (new-waiton-y
87c0: 20 20 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 (inexact->exa
87d0: 63 74 0a 09 09 09 20 20 20 20 20 28 72 6f 75 6e ct.... (roun
87e0: 64 20 28 69 66 20 28 3e 20 64 65 6c 74 61 2d 79 d (if (> delta-y
87f0: 20 30 29 0a 09 09 09 09 09 28 2d 20 77 61 69 74 0)......(- wait
8800: 6f 6e 2d 63 65 6e 74 65 72 2d 79 20 79 2d 61 64 on-center-y y-ad
8810: 6a 29 0a 09 09 09 09 09 28 2b 20 77 61 69 74 6f j)......(+ waito
8820: 6e 2d 63 65 6e 74 65 72 2d 79 20 79 2d 61 64 6a n-center-y y-adj
8830: 29 29 29 29 29 29 0a 20 20 3b 3b 20 28 63 61 6e )))))). ;; (can
8840: 76 61 73 2d 6c 69 6e 65 2d 77 69 64 74 68 2d 73 vas-line-width-s
8850: 65 74 21 20 63 6e 76 20 35 29 0a 20 20 28 63 61 et! cnv 5). (ca
8860: 6e 76 61 73 2d 6c 69 6e 65 21 20 63 6e 76 0a 09 nvas-line! cnv..
8870: 09 74 65 73 74 2d 62 6f 78 2d 63 65 6e 74 65 72 .test-box-center
8880: 2d 78 0a 09 09 74 65 73 74 2d 62 6f 78 2d 63 65 -x...test-box-ce
8890: 6e 74 65 72 2d 79 0a 09 09 6e 65 77 2d 77 61 69 nter-y...new-wai
88a0: 74 6f 6e 2d 78 0a 09 09 6e 65 77 2d 77 61 69 74 ton-x...new-wait
88b0: 6f 6e 2d 79 0a 09 09 29 0a 20 20 28 63 61 6e 76 on-y...). (canv
88c0: 61 73 2d 6d 61 72 6b 21 20 63 6e 76 20 6e 65 77 as-mark! cnv new
88d0: 2d 77 61 69 74 6f 6e 2d 78 20 6e 65 77 2d 77 61 -waiton-x new-wa
88e0: 69 74 6f 6e 2d 79 29 29 29 0a 0a 28 64 65 66 69 iton-y)))..(defi
88f0: 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d ne (dcommon:get-
8900: 62 6f 78 2d 63 65 6e 74 65 72 20 62 6f 78 29 0a box-center box).
8910: 20 20 28 6c 65 74 2a 20 28 28 6c 6c 78 20 20 28 (let* ((llx (
8920: 6c 69 73 74 2d 72 65 66 20 62 6f 78 20 30 29 29 list-ref box 0))
8930: 0a 09 20 28 6c 6c 79 20 20 28 6c 69 73 74 2d 72 .. (lly (list-r
8940: 65 66 20 62 6f 78 20 31 29 29 0a 09 20 28 62 6f ef box 1)).. (bo
8950: 78 77 20 28 6c 69 73 74 2d 72 65 66 20 62 6f 78 xw (list-ref box
8960: 20 34 29 29 0a 09 20 28 62 6f 78 68 20 28 6c 69 4)).. (boxh (li
8970: 73 74 2d 72 65 66 20 62 6f 78 20 35 29 29 29 0a st-ref box 5))).
8980: 20 20 20 20 28 76 65 63 74 6f 72 20 28 2b 20 6c (vector (+ l
8990: 6c 78 20 28 2f 20 62 6f 78 77 20 32 29 29 0a 09 lx (/ boxw 2))..
89a0: 20 20 20 20 28 2b 20 6c 6c 79 20 28 2f 20 62 6f (+ lly (/ bo
89b0: 78 68 20 32 29 29 29 29 29 0a 0a 28 64 65 66 69 xh 2)))))..(defi
89c0: 6e 65 2d 69 6e 6c 69 6e 65 20 28 6e 75 6d 2d 3e ne-inline (num->
89d0: 69 6e 74 20 6e 75 6d 29 0a 20 20 28 69 6e 65 78 int num). (inex
89e0: 61 63 74 2d 3e 65 78 61 63 74 20 28 72 6f 75 6e act->exact (roun
89f0: 64 20 6e 75 6d 29 29 29 0a 0a 28 64 65 66 69 6e d num)))..(defin
8a00: 65 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d e (dcommon:draw-
8a10: 65 64 67 65 73 20 63 6e 76 20 78 6f 66 66 73 65 edges cnv xoffse
8a20: 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c 65 66 t yoffset scalef
8a30: 20 65 64 67 65 73 29 0a 20 20 28 66 6f 72 2d 65 edges). (for-e
8a40: 61 63 68 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 ach. (lambda (
8a50: 65 29 0a 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f e). (let loo
8a60: 70 20 28 28 78 31 20 28 63 61 72 20 65 29 29 0a p ((x1 (car e)).
8a70: 09 09 28 79 31 20 28 63 61 64 72 20 65 29 29 0a ..(y1 (cadr e)).
8a80: 09 09 28 78 32 20 23 66 29 0a 09 09 28 79 32 20 ..(x2 #f)...(y2
8a90: 23 66 29 0a 09 09 28 74 61 6c 20 28 63 64 64 72 #f)...(tal (cddr
8aa0: 20 65 29 29 29 0a 20 20 20 20 20 20 20 28 69 66 e))). (if
8ab0: 20 28 61 6e 64 20 78 31 20 79 31 20 78 32 20 79 (and x1 y1 x2 y
8ac0: 32 29 0a 09 20 20 20 28 63 61 6e 76 61 73 2d 6c 2).. (canvas-l
8ad0: 69 6e 65 21 20 0a 09 20 20 20 20 63 6e 76 20 0a ine! .. cnv .
8ae0: 09 20 20 20 20 28 6e 75 6d 2d 3e 69 6e 74 20 28 . (num->int (
8af0: 64 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 dcommon:x->canva
8b00: 73 20 78 31 20 73 63 61 6c 65 66 20 78 6f 66 66 s x1 scalef xoff
8b10: 73 65 74 29 29 0a 09 20 20 20 20 28 6e 75 6d 2d set)).. (num-
8b20: 3e 69 6e 74 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d >int (dcommon:y-
8b30: 3e 63 61 6e 76 61 73 20 79 31 20 73 63 61 6c 65 >canvas y1 scale
8b40: 66 20 79 6f 66 66 73 65 74 29 29 0a 09 20 20 20 f yoffset))..
8b50: 20 28 6e 75 6d 2d 3e 69 6e 74 20 28 64 63 6f 6d (num->int (dcom
8b60: 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 73 20 78 32 mon:x->canvas x2
8b70: 20 73 63 61 6c 65 66 20 78 6f 66 66 73 65 74 29 scalef xoffset)
8b80: 29 0a 09 20 20 20 20 28 6e 75 6d 2d 3e 69 6e 74 ).. (num->int
8b90: 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e 63 61 6e (dcommon:y->can
8ba0: 76 61 73 20 79 32 20 73 63 61 6c 65 66 20 79 6f vas y2 scalef yo
8bb0: 66 66 73 65 74 29 29 29 29 20 3b 3b 20 28 6e 75 ffset)))) ;; (nu
8bc0: 6d 2d 3e 69 6e 74 20 78 31 29 28 6e 75 6d 2d 3e m->int x1)(num->
8bd0: 69 6e 74 20 79 31 29 28 6e 75 6d 2d 3e 69 6e 74 int y1)(num->int
8be0: 20 78 32 29 28 6e 75 6d 2d 3e 69 6e 74 20 79 32 x2)(num->int y2
8bf0: 29 29 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 ))). (if (
8c00: 3c 20 28 6c 65 6e 67 74 68 20 74 61 6c 29 20 32 < (length tal) 2
8c10: 29 0a 09 20 20 20 28 63 61 6e 76 61 73 2d 6d 61 ).. (canvas-ma
8c20: 72 6b 21 20 63 6e 76 0a 09 09 09 20 28 6e 75 6d rk! cnv.... (num
8c30: 2d 3e 69 6e 74 20 28 64 63 6f 6d 6d 6f 6e 3a 78 ->int (dcommon:x
8c40: 2d 3e 63 61 6e 76 61 73 20 78 31 20 73 63 61 6c ->canvas x1 scal
8c50: 65 66 20 78 6f 66 66 73 65 74 29 29 0a 09 09 09 ef xoffset))....
8c60: 20 28 6e 75 6d 2d 3e 69 6e 74 20 28 64 63 6f 6d (num->int (dcom
8c70: 6d 6f 6e 3a 79 2d 3e 63 61 6e 76 61 73 20 79 31 mon:y->canvas y1
8c80: 20 73 63 61 6c 65 66 20 79 6f 66 66 73 65 74 29 scalef yoffset)
8c90: 29 29 20 3b 3b 20 28 6e 75 6d 2d 3e 69 6e 74 20 )) ;; (num->int
8ca0: 78 31 29 28 6e 75 6d 2d 3e 69 6e 74 20 79 31 29 x1)(num->int y1)
8cb0: 29 0a 09 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 ).. (loop (car
8cc0: 20 74 61 6c 29 28 63 61 64 72 20 74 61 6c 29 20 tal)(cadr tal)
8cd0: 78 31 20 79 31 20 28 63 64 64 72 20 74 61 6c 29 x1 y1 (cddr tal)
8ce0: 29 29 29 29 0a 20 20 20 3b 3b 20 28 6d 61 70 20 )))). ;; (map
8cf0: 28 6c 61 6d 62 64 61 20 28 65 29 28 6d 61 70 20 (lambda (e)(map
8d00: 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 75 6d 2d (lambda (x)(num-
8d10: 3e 69 6e 74 20 28 2a 20 78 20 73 63 61 6c 65 66 >int (* x scalef
8d20: 29 29 29 20 65 29 29 20 65 64 67 65 73 29 29 29 ))) e)) edges)))
8d30: 0a 20 20 20 65 64 67 65 73 29 29 0a 0a 0a 28 64 . edges))...(d
8d40: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 64 efine (dcommon:d
8d50: 72 61 77 2d 61 72 72 6f 77 73 20 63 6e 76 20 74 raw-arrows cnv t
8d60: 65 73 74 6e 61 6d 65 20 74 65 73 74 73 2d 68 61 estname tests-ha
8d70: 73 68 20 74 65 73 74 2d 72 65 63 6f 72 64 73 29 sh test-records)
8d80: 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d . (let* ((test-
8d90: 62 6f 78 2d 69 6e 66 6f 20 20 20 28 68 61 73 68 box-info (hash
8da0: 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 73 -table-ref tests
8db0: 2d 68 61 73 68 20 74 65 73 74 6e 61 6d 65 29 29 -hash testname))
8dc0: 0a 09 20 28 74 65 73 74 2d 62 6f 78 2d 63 65 6e .. (test-box-cen
8dd0: 74 65 72 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 ter (dcommon:get
8de0: 2d 62 6f 78 2d 63 65 6e 74 65 72 20 74 65 73 74 -box-center test
8df0: 2d 62 6f 78 2d 69 6e 66 6f 29 29 0a 09 20 28 74 -box-info)).. (t
8e00: 65 73 74 2d 72 65 63 6f 72 64 20 20 20 20 20 28 est-record (
8e10: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 hash-table-ref t
8e20: 65 73 74 2d 72 65 63 6f 72 64 73 20 74 65 73 74 est-records test
8e30: 6e 61 6d 65 29 29 0a 09 20 28 77 61 69 74 6f 6e name)).. (waiton
8e40: 73 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f s (vecto
8e50: 72 2d 72 65 66 20 74 65 73 74 2d 72 65 63 6f 72 r-ref test-recor
8e60: 64 20 32 29 29 29 0a 20 20 20 20 28 66 6f 72 2d d 2))). (for-
8e70: 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 each. (lambd
8e80: 61 20 28 77 61 69 74 6f 6e 29 0a 20 20 20 20 20 a (waiton).
8e90: 20 20 28 6c 65 74 2a 20 28 28 77 61 69 74 6f 6e (let* ((waiton
8ea0: 2d 62 6f 78 2d 69 6e 66 6f 20 28 68 61 73 68 2d -box-info (hash-
8eb0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
8ec0: 74 20 74 65 73 74 73 2d 68 61 73 68 20 77 61 69 t tests-hash wai
8ed0: 74 6f 6e 20 23 66 29 29 0a 09 20 20 20 20 20 20 ton #f))..
8ee0: 28 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 20 20 (waiton-center
8ef0: 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 62 6f (dcommon:get-bo
8f00: 78 2d 63 65 6e 74 65 72 20 28 6f 72 20 77 61 69 x-center (or wai
8f10: 74 6f 6e 2d 62 6f 78 2d 69 6e 66 6f 20 74 65 73 ton-box-info tes
8f20: 74 2d 62 6f 78 2d 69 6e 66 6f 29 29 29 29 0a 09 t-box-info))))..
8f30: 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 61 (dcommon:draw-a
8f40: 72 72 6f 77 20 63 6e 76 20 74 65 73 74 2d 62 6f rrow cnv test-bo
8f50: 78 2d 63 65 6e 74 65 72 20 77 61 69 74 6f 6e 2d x-center waiton-
8f60: 63 65 6e 74 65 72 29 29 29 0a 20 20 20 20 20 77 center))). w
8f70: 61 69 74 6f 6e 73 29 0a 20 20 20 20 3b 3b 20 28 aitons). ;; (
8f80: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
8f90: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
8fa0: 20 22 74 65 73 74 2d 62 6f 78 2d 69 6e 66 6f 3d "test-box-info=
8fb0: 22 20 74 65 73 74 2d 62 6f 78 2d 69 6e 66 6f 29 " test-box-info)
8fc0: 0a 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 . ;; (debug:p
8fd0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
8fe0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 74 65 73 74 2d log-port* "test-
8ff0: 72 65 63 6f 72 64 3d 22 20 74 65 73 74 2d 72 65 record=" test-re
9000: 63 6f 72 64 29 0a 20 20 20 20 29 29 0a 0a 28 64 cord). ))..(d
9010: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 65 efine (dcommon:e
9020: 73 74 69 6d 61 74 65 2d 73 63 61 6c 65 20 73 69 stimate-scale si
9030: 7a 65 78 20 73 69 7a 65 79 20 6f 72 69 67 69 6e zex sizey origin
9040: 78 20 6f 72 69 67 69 6e 79 20 6e 6f 64 65 73 29 x originy nodes)
9050: 0a 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 69 . ;; (print "si
9060: 7a 65 78 3a 20 22 20 73 69 7a 65 78 20 22 20 73 zex: " sizex " s
9070: 69 7a 65 79 3a 20 22 20 73 69 7a 65 79 20 22 20 izey: " sizey "
9080: 6f 72 69 67 69 6e 78 3a 20 22 20 6f 72 69 67 69 originx: " origi
9090: 6e 78 20 22 20 6f 72 69 67 69 6e 79 3a 20 22 20 nx " originy: "
90a0: 6f 72 69 67 69 6e 79 20 22 20 6e 6f 64 65 73 3a originy " nodes:
90b0: 20 22 20 6e 6f 64 65 73 29 0a 20 20 28 6c 65 74 " nodes). (let
90c0: 2a 20 28 28 6d 61 78 78 20 31 29 0a 09 20 28 6d * ((maxx 1).. (m
90d0: 61 78 79 20 31 29 29 0a 20 20 20 20 28 66 6f 72 axy 1)). (for
90e0: 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 -each. (lamb
90f0: 64 61 20 28 6e 6f 64 65 29 0a 20 20 20 20 20 20 da (node).
9100: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 63 61 (if (equal? (ca
9110: 72 20 6e 6f 64 65 29 20 22 6e 6f 64 65 22 29 0a r node) "node").
9120: 09 20 20 20 28 6c 65 74 20 28 28 78 20 28 73 74 . (let ((x (st
9130: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6c 69 ring->number (li
9140: 73 74 2d 72 65 66 20 6e 6f 64 65 20 32 29 29 29 st-ref node 2)))
9150: 0a 09 09 20 28 79 20 28 73 74 72 69 6e 67 2d 3e ... (y (string->
9160: 6e 75 6d 62 65 72 20 28 6c 69 73 74 2d 72 65 66 number (list-ref
9170: 20 6e 6f 64 65 20 33 29 29 29 29 0a 09 20 20 20 node 3))))..
9180: 20 20 28 69 66 20 28 61 6e 64 20 78 20 28 3e 20 (if (and x (>
9190: 78 20 6d 61 78 78 29 29 28 73 65 74 21 20 6d 61 x maxx))(set! ma
91a0: 78 78 20 78 29 29 0a 09 20 20 20 20 20 28 69 66 xx x)).. (if
91b0: 20 28 61 6e 64 20 79 20 28 3e 20 79 20 6d 61 78 (and y (> y max
91c0: 79 29 29 28 73 65 74 21 20 6d 61 78 79 20 79 29 y))(set! maxy y)
91d0: 29 29 29 29 0a 20 20 20 20 20 6e 6f 64 65 73 29 )))). nodes)
91e0: 0a 20 20 20 20 28 6c 65 74 20 28 28 73 63 61 6c . (let ((scal
91f0: 65 78 20 28 2f 20 73 69 7a 65 78 20 6d 61 78 78 ex (/ sizex maxx
9200: 29 29 0a 09 20 20 28 73 63 61 6c 65 79 20 28 2f )).. (scaley (/
9210: 20 73 69 7a 65 79 20 6d 61 78 79 29 29 29 0a 20 sizey maxy))).
9220: 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 ;; (print "
9230: 6d 61 78 78 3a 20 22 20 6d 61 78 78 20 22 20 6d maxx: " maxx " m
9240: 61 78 79 3a 20 22 20 6d 61 78 79 20 22 20 73 63 axy: " maxy " sc
9250: 61 6c 65 78 3a 20 22 20 73 63 61 6c 65 78 20 22 alex: " scalex "
9260: 20 73 63 61 6c 65 79 3a 20 22 20 73 63 61 6c 65 scaley: " scale
9270: 79 29 0a 20 20 20 20 20 20 28 6d 69 6e 20 73 63 y). (min sc
9280: 61 6c 65 78 20 73 63 61 6c 65 79 29 29 29 29 0a alex scaley)))).
9290: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f .(define (dcommo
92a0: 6e 3a 67 65 74 2d 78 6f 66 66 73 65 74 20 74 65 n:get-xoffset te
92b0: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 73 sts-draw-state s
92c0: 69 7a 65 78 2d 69 6e 20 78 61 64 6a 2d 69 6e 29 izex-in xadj-in)
92d0: 0a 20 20 28 6c 65 74 20 28 28 78 61 64 6a 20 20 . (let ((xadj
92e0: 28 6f 72 20 78 61 64 6a 2d 69 6e 20 20 28 68 61 (or xadj-in (ha
92f0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
9300: 61 75 6c 74 20 74 65 73 74 73 2d 64 72 61 77 2d ault tests-draw-
9310: 73 74 61 74 65 20 27 78 61 64 6a 20 30 29 29 29 state 'xadj 0)))
9320: 0a 09 28 73 69 7a 65 78 20 28 6f 72 20 73 69 7a ..(sizex (or siz
9330: 65 78 2d 69 6e 20 28 68 61 73 68 2d 74 61 62 6c ex-in (hash-tabl
9340: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 e-ref/default te
9350: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 sts-draw-state '
9360: 73 69 7a 65 78 20 35 30 30 29 29 29 29 0a 20 20 sizex 500)))).
9370: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
9380: 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 t! tests-draw-st
9390: 61 74 65 20 27 78 61 64 6a 20 78 61 64 6a 29 20 ate 'xadj xadj)
93a0: 3b 3b 20 66 6f 72 20 75 73 65 20 69 6e 20 64 65 ;; for use in de
93b0: 2d 73 63 61 6c 69 6e 67 20 77 68 65 6e 20 68 61 -scaling when ha
93c0: 6e 64 6c 69 6e 67 20 6d 6f 75 73 65 20 63 6c 69 ndling mouse cli
93d0: 63 6b 73 0a 20 20 20 20 28 68 61 73 68 2d 74 61 cks. (hash-ta
93e0: 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d 64 ble-set! tests-d
93f0: 72 61 77 2d 73 74 61 74 65 20 27 73 69 7a 65 78 raw-state 'sizex
9400: 20 73 69 7a 65 78 29 0a 20 20 20 20 28 2a 20 28 sizex). (* (
9410: 2f 20 73 69 7a 65 78 20 32 29 20 28 2d 20 30 2e / sizex 2) (- 0.
9420: 35 20 78 61 64 6a 29 29 29 29 0a 0a 28 64 65 66 5 xadj))))..(def
9430: 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 ine (dcommon:get
9440: 2d 79 6f 66 66 73 65 74 20 74 65 73 74 73 2d 64 -yoffset tests-d
9450: 72 61 77 2d 73 74 61 74 65 20 73 69 7a 65 79 2d raw-state sizey-
9460: 69 6e 20 79 61 64 6a 2d 69 6e 29 0a 20 20 28 6c in yadj-in). (l
9470: 65 74 20 28 28 79 61 64 6a 20 20 28 6f 72 20 79 et ((yadj (or y
9480: 61 64 6a 2d 69 6e 20 20 28 68 61 73 68 2d 74 61 adj-in (hash-ta
9490: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
94a0: 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 tests-draw-state
94b0: 20 27 79 61 64 6a 20 30 29 29 29 0a 09 28 73 69 'yadj 0)))..(si
94c0: 7a 65 79 20 28 6f 72 20 73 69 7a 65 79 2d 69 6e zey (or sizey-in
94d0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
94e0: 2f 64 65 66 61 75 6c 74 20 74 65 73 74 73 2d 64 /default tests-d
94f0: 72 61 77 2d 73 74 61 74 65 20 27 73 69 7a 65 79 raw-state 'sizey
9500: 20 35 30 30 29 29 29 29 0a 20 20 20 20 28 68 61 500)))). (ha
9510: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 sh-table-set! te
9520: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 sts-draw-state '
9530: 79 61 64 6a 20 79 61 64 6a 29 20 3b 3b 20 66 6f yadj yadj) ;; fo
9540: 72 20 75 73 65 20 69 6e 20 64 65 2d 73 63 61 6c r use in de-scal
9550: 69 6e 67 20 77 68 65 6e 20 68 61 6e 64 6c 69 6e ing when handlin
9560: 67 20 6d 6f 75 73 65 20 63 6c 69 63 6b 73 0a 20 g mouse clicks.
9570: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
9580: 65 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d 73 et! tests-draw-s
9590: 74 61 74 65 20 27 73 69 7a 65 79 20 73 69 7a 65 tate 'sizey size
95a0: 79 29 0a 20 20 20 20 28 2a 20 28 2f 20 73 69 7a y). (* (/ siz
95b0: 65 79 20 32 29 20 28 2d 20 79 61 64 6a 20 30 2e ey 2) (- yadj 0.
95c0: 35 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 5))))..(define (
95d0: 64 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 dcommon:x->canva
95e0: 73 20 78 20 73 63 61 6c 65 66 20 78 6f 66 66 73 s x scalef xoffs
95f0: 65 74 29 0a 20 20 28 2b 20 78 6f 66 66 73 65 74 et). (+ xoffset
9600: 20 28 2a 20 78 20 73 63 61 6c 65 66 29 29 29 0a (* x scalef))).
9610: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f .(define (dcommo
9620: 6e 3a 79 2d 3e 63 61 6e 76 61 73 20 79 20 73 63 n:y->canvas y sc
9630: 61 6c 65 66 20 79 6f 66 66 73 65 74 29 0a 20 20 alef yoffset).
9640: 28 2b 20 79 6f 66 66 73 65 74 20 28 2a 20 79 20 (+ yoffset (* y
9650: 73 63 61 6c 65 66 29 29 29 0a 0a 3b 3b 20 73 69 scalef)))..;; si
9660: 7a 65 78 2c 20 73 69 7a 65 79 20 20 20 20 20 2d zex, sizey -
9670: 20 63 61 6e 76 61 73 20 73 69 7a 65 0a 3b 3b 20 canvas size.;;
9680: 6f 72 69 67 69 6e 78 2c 20 6f 72 69 67 69 6e 79 originx, originy
9690: 20 2d 20 63 61 6e 76 61 73 20 6f 72 69 67 69 6e - canvas origin
96a0: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 63 6f .;;.(define (dco
96b0: 6d 6d 6f 6e 3a 69 6e 69 74 69 61 6c 2d 64 72 61 mmon:initial-dra
96c0: 77 2d 74 65 73 74 73 20 63 6e 76 20 78 61 64 6a w-tests cnv xadj
96d0: 20 79 61 64 6a 20 73 69 7a 65 78 20 73 69 7a 65 yadj sizex size
96e0: 79 20 73 69 7a 65 78 6d 6d 20 73 69 7a 65 79 6d y sizexmm sizeym
96f0: 6d 20 6f 72 69 67 69 6e 78 20 6f 72 69 67 69 6e m originx origin
9700: 79 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 y tests-draw-sta
9710: 74 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 te sorted-testna
9720: 6d 65 73 20 74 65 73 74 2d 72 65 63 6f 72 64 73 mes test-records
9730: 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 6f 74 2d ). (let* ((dot-
9740: 64 61 74 61 20 3b 3b 20 28 6d 61 70 20 63 64 72 data ;; (map cdr
9750: 20 28 66 69 6c 74 65 72 0a 09 09 20 20 20 3b 3b (filter... ;;
9760: 20 09 20 20 28 6c 61 6d 62 64 61 20 28 78 29 28 . (lambda (x)(
9770: 65 71 75 61 6c 3f 20 22 6e 6f 64 65 22 20 28 63 equal? "node" (c
9780: 61 72 20 78 29 29 29 0a 09 20 20 28 6d 61 70 20 ar x))).. (map
9790: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 74 65 string-split (te
97a0: 73 74 73 3a 6c 61 7a 79 2d 64 6f 74 20 74 65 73 sts:lazy-dot tes
97b0: 74 2d 72 65 63 6f 72 64 73 20 22 70 6c 61 69 6e t-records "plain
97c0: 22 20 73 69 7a 65 78 20 73 69 7a 65 79 29 29 29 " sizex sizey)))
97d0: 20 3b 3b 20 28 74 65 73 74 73 3a 65 61 73 79 2d ;; (tests:easy-
97e0: 64 6f 74 20 74 65 73 74 2d 72 65 63 6f 72 64 73 dot test-records
97f0: 20 22 70 6c 61 69 6e 22 29 29 29 0a 09 20 28 78 "plain"))).. (x
9800: 6f 66 66 73 65 74 09 20 28 64 63 6f 6d 6d 6f 6e offset. (dcommon
9810: 3a 67 65 74 2d 78 6f 66 66 73 65 74 20 74 65 73 :get-xoffset tes
9820: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 73 69 ts-draw-state si
9830: 7a 65 78 20 78 61 64 6a 29 29 0a 09 20 28 79 6f zex xadj)).. (yo
9840: 66 66 73 65 74 20 20 20 20 20 20 20 20 28 64 63 ffset (dc
9850: 6f 6d 6d 6f 6e 3a 67 65 74 2d 79 6f 66 66 73 65 ommon:get-yoffse
9860: 74 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 t tests-draw-sta
9870: 74 65 20 73 69 7a 65 79 20 79 61 64 6a 29 29 0a te sizey yadj)).
9880: 09 20 28 6e 6f 2d 64 6f 74 20 20 20 20 20 20 20 . (no-dot
9890: 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 (configf:looku
98a0: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 p *configdat* "s
98b0: 65 74 75 70 22 20 22 6e 6f 64 6f 74 22 29 29 0a etup" "nodot")).
98c0: 09 20 28 62 6f 78 68 20 20 20 20 20 20 20 20 20 . (boxh
98d0: 20 20 31 35 29 0a 09 20 28 62 6f 78 77 20 20 20 15).. (boxw
98e0: 20 20 20 20 20 20 20 20 31 30 29 0a 09 20 28 6d 10).. (m
98f0: 61 72 67 69 6e 20 20 20 20 20 20 20 20 20 35 29 argin 5)
9900: 0a 09 20 28 74 65 73 74 73 2d 69 6e 66 6f 20 20 .. (tests-info
9910: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
9920: 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 ef tests-draw-st
9930: 61 74 65 20 27 74 65 73 74 73 2d 69 6e 66 6f 29 ate 'tests-info)
9940: 29 0a 09 20 28 73 65 6c 65 63 74 65 64 2d 74 65 ).. (selected-te
9950: 73 74 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d sts (hash-table-
9960: 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 ref tests-draw-s
9970: 74 61 74 65 20 27 73 65 6c 65 63 74 65 64 2d 74 tate 'selected-t
9980: 65 73 74 73 20 29 29 0a 09 20 28 73 63 61 6c 65 ests )).. (scale
9990: 66 20 20 20 20 20 20 20 20 20 28 69 66 20 6e 6f f (if no
99a0: 2d 64 6f 74 0a 09 09 09 20 20 20 20 20 31 0a 09 -dot.... 1..
99b0: 09 09 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a .. (dcommon:
99c0: 65 73 74 69 6d 61 74 65 2d 73 63 61 6c 65 20 73 estimate-scale s
99d0: 69 7a 65 78 20 73 69 7a 65 79 20 6f 72 69 67 69 izex sizey origi
99e0: 6e 78 20 6f 72 69 67 69 6e 79 20 64 6f 74 2d 64 nx originy dot-d
99f0: 61 74 61 29 29 29 0a 09 20 28 73 6f 72 74 65 64 ata))).. (sorted
9a00: 2d 74 65 73 74 6e 61 6d 65 73 20 28 69 66 20 6e -testnames (if n
9a10: 6f 2d 64 6f 74 0a 09 09 09 20 20 20 20 20 20 20 o-dot....
9a20: 28 73 6f 72 74 20 73 6f 72 74 65 64 2d 74 65 73 (sort sorted-tes
9a30: 74 6e 61 6d 65 73 20 73 74 72 69 6e 67 3e 3d 3f tnames string>=?
9a40: 29 0a 09 09 09 20 20 20 20 20 20 20 73 6f 72 74 ).... sort
9a50: 65 64 2d 74 65 73 74 6e 61 6d 65 73 29 29 0a 09 ed-testnames))..
9a60: 20 28 63 75 72 72 2d 78 20 20 20 20 20 20 20 20 (curr-x
9a70: 20 30 29 20 20 3b 3b 20 4e 42 2f 2f 20 4e 4f 54 0) ;; NB// NOT
9a80: 20 73 63 72 65 65 6e 20 75 6e 69 74 73 0a 09 20 screen units..
9a90: 28 63 75 72 72 2d 79 20 20 20 20 20 20 20 20 20 (curr-y
9aa0: 28 2f 20 28 2d 20 73 69 7a 65 79 20 62 6f 78 68 (/ (- sizey boxh
9ab0: 20 6d 61 72 67 69 6e 29 20 73 63 61 6c 65 66 29 margin) scalef)
9ac0: 29 20 3b 3b 20 75 73 65 64 20 77 68 65 6e 20 6e ) ;; used when n
9ad0: 6f 2d 64 6f 74 0a 09 20 28 73 63 61 6c 65 64 2d o-dot.. (scaled-
9ae0: 73 69 7a 65 78 20 20 20 28 2f 20 73 69 7a 65 78 sizex (/ sizex
9af0: 20 73 63 61 6c 65 66 29 29 29 0a 0a 20 20 20 20 scalef)))..
9b00: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
9b10: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 tests-draw-stat
9b20: 65 20 27 73 63 61 6c 65 66 20 73 63 61 6c 65 66 e 'scalef scalef
9b30: 29 0a 20 20 20 20 0a 20 20 20 20 28 6c 65 74 20 ). . (let
9b40: 28 28 6c 6f 6e 67 65 73 74 2d 73 74 72 20 20 20 ((longest-str
9b50: 28 69 66 20 28 6e 75 6c 6c 3f 20 73 6f 72 74 65 (if (null? sorte
9b60: 64 2d 74 65 73 74 6e 61 6d 65 73 29 20 22 20 20 d-testnames) "
9b70: 20 20 20 20 20 20 20 22 20 28 63 61 72 20 28 73 " (car (s
9b80: 6f 72 74 20 73 6f 72 74 65 64 2d 74 65 73 74 6e ort sorted-testn
9b90: 61 6d 65 73 20 28 6c 61 6d 62 64 61 20 28 61 20 ames (lambda (a
9ba0: 62 29 28 3e 3d 20 28 73 74 72 69 6e 67 2d 6c 65 b)(>= (string-le
9bb0: 6e 67 74 68 20 61 29 28 73 74 72 69 6e 67 2d 6c ngth a)(string-l
9bc0: 65 6e 67 74 68 20 62 29 29 29 29 29 29 29 29 0a ength b)))))))).
9bd0: 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 (let-value
9be0: 73 20 28 28 28 78 2d 6d 61 78 20 79 2d 6d 61 78 s (((x-max y-max
9bf0: 29 20 28 63 61 6e 76 61 73 2d 74 65 78 74 2d 73 ) (canvas-text-s
9c00: 69 7a 65 20 63 6e 76 20 6c 6f 6e 67 65 73 74 2d ize cnv longest-
9c10: 73 74 72 29 29 29 0a 09 28 69 66 20 28 3e 20 78 str)))..(if (> x
9c20: 2d 6d 61 78 20 62 6f 78 77 29 28 73 65 74 21 20 -max boxw)(set!
9c30: 62 6f 78 77 20 28 2b 20 31 30 20 78 2d 6d 61 78 boxw (+ 10 x-max
9c40: 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 70 72 ))))). ;; (pr
9c50: 69 6e 74 20 22 73 69 7a 65 78 3a 20 22 20 73 69 int "sizex: " si
9c60: 7a 65 78 20 22 20 73 69 7a 65 79 3a 20 22 20 73 zex " sizey: " s
9c70: 69 7a 65 79 20 22 20 66 6f 6e 74 3a 20 22 20 28 izey " font: " (
9c80: 63 61 6e 76 61 73 2d 66 6f 6e 74 20 63 6e 76 29 canvas-font cnv)
9c90: 20 22 20 6f 72 69 67 69 6e 78 3a 20 22 20 6f 72 " originx: " or
9ca0: 69 67 69 6e 78 20 22 20 6f 72 69 67 69 6e 79 3a iginx " originy:
9cb0: 20 22 20 6f 72 69 67 69 6e 79 20 22 20 78 74 6f " originy " xto
9cc0: 72 69 67 3a 20 22 20 78 74 6f 72 69 67 20 22 20 rig: " xtorig "
9cd0: 79 74 6f 72 69 67 3a 20 22 20 79 74 6f 72 69 67 ytorig: " ytorig
9ce0: 20 22 20 78 61 64 6a 3a 20 22 20 78 61 64 6a 20 " xadj: " xadj
9cf0: 22 20 79 61 64 6a 3a 20 22 20 79 61 64 6a 29 0a " yadj: " yadj).
9d00: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 (if (not (nu
9d10: 6c 6c 3f 20 73 6f 72 74 65 64 2d 74 65 73 74 6e ll? sorted-testn
9d20: 61 6d 65 73 29 29 0a 09 28 6c 65 74 20 6c 6f 6f ames))..(let loo
9d30: 70 20 28 28 68 65 64 20 28 63 61 72 20 28 72 65 p ((hed (car (re
9d40: 76 65 72 73 65 20 73 6f 72 74 65 64 2d 74 65 73 verse sorted-tes
9d50: 74 6e 61 6d 65 73 29 29 29 0a 09 09 20 20 20 28 tnames)))... (
9d60: 74 61 6c 20 28 63 64 72 20 28 72 65 76 65 72 73 tal (cdr (revers
9d70: 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d e sorted-testnam
9d80: 65 73 29 29 29 29 0a 09 20 20 28 6c 65 74 2a 20 es)))).. (let*
9d90: 28 28 6e 6f 64 65 64 61 74 20 28 69 66 20 6e 6f ((nodedat (if no
9da0: 2d 64 6f 74 0a 09 09 09 20 20 20 20 20 20 23 66 -dot.... #f
9db0: 0a 09 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 .... (let (
9dc0: 28 74 6d 70 72 65 73 20 28 66 69 6c 74 65 72 20 (tmpres (filter
9dd0: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 (lambda (x).....
9de0: 09 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 .. (if (and
9df0: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 78 29 29 (not (null? x))
9e00: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
9e10: 65 71 75 61 6c 3f 20 28 63 61 72 20 78 29 20 22 equal? (car x) "
9e20: 6e 6f 64 65 22 29 29 0a 09 09 09 09 09 09 09 20 node"))........
9e30: 20 28 65 71 75 61 6c 3f 20 68 65 64 20 28 63 61 (equal? hed (ca
9e40: 64 72 20 78 29 29 0a 09 09 09 09 09 09 09 20 20 dr x))........
9e50: 23 66 29 29 0a 09 09 09 09 09 09 20 20 20 20 64 #f))....... d
9e60: 6f 74 2d 64 61 74 61 29 29 29 0a 09 09 09 09 28 ot-data))).....(
9e70: 69 66 20 28 6e 75 6c 6c 3f 20 74 6d 70 72 65 73 if (null? tmpres
9e80: 29 0a 09 09 09 09 20 20 20 20 3b 3b 20 20 20 20 )..... ;;
9e90: 20 20 20 20 20 20 20 6c 6c 78 20 20 6c 6c 79 20 llx lly
9ea0: 62 6f 78 77 20 62 6f 78 68 0a 09 09 09 09 20 20 boxw boxh.....
9eb0: 20 20 28 6c 69 73 74 20 22 30 22 20 22 31 22 20 (list "0" "1"
9ec0: 22 31 22 20 28 63 6f 6e 63 20 28 6c 65 6e 67 74 "1" (conc (lengt
9ed0: 68 20 74 61 6c 29 29 20 22 32 22 20 22 30 2e 35 h tal)) "2" "0.5
9ee0: 22 29 20 3b 3b 20 72 65 74 75 72 6e 20 73 6f 6d ") ;; return som
9ef0: 65 20 70 6c 61 63 65 68 6f 6c 64 65 72 20 6a 75 e placeholder ju
9f00: 6e 6b 20 69 66 20 6e 6f 20 64 61 74 20 66 6f 75 nk if no dat fou
9f10: 6e 64 0a 09 09 09 09 20 20 20 20 28 63 61 72 20 nd..... (car
9f20: 74 6d 70 72 65 73 29 29 29 29 29 0a 09 09 20 28 tmpres)))))... (
9f30: 65 64 67 65 64 61 74 20 28 69 66 20 6e 6f 2d 64 edgedat (if no-d
9f40: 6f 74 0a 09 09 09 20 20 20 20 20 20 27 28 29 0a ot.... '().
9f50: 09 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 ... (let ((
9f60: 65 64 67 65 73 20 28 66 69 6c 74 65 72 20 28 6c edges (filter (l
9f70: 61 6d 62 64 61 20 28 78 29 20 20 3b 3b 20 66 69 ambda (x) ;; fi
9f80: 6c 74 65 72 20 66 6f 72 20 65 64 67 65 0a 09 09 lter for edge...
9f90: 09 09 09 09 20 20 20 20 20 28 69 66 20 28 61 6e .... (if (an
9fa0: 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 78 29 d (not (null? x)
9fb0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 28 )........ (
9fc0: 65 71 75 61 6c 3f 20 28 63 61 72 20 78 29 20 22 equal? (car x) "
9fd0: 65 64 67 65 22 29 29 0a 09 09 09 09 09 09 09 20 edge"))........
9fe0: 28 65 71 75 61 6c 3f 20 68 65 64 20 28 63 61 64 (equal? hed (cad
9ff0: 72 20 78 29 29 0a 09 09 09 09 09 09 09 20 23 66 r x))........ #f
a000: 29 29 0a 09 09 09 09 09 09 20 20 20 64 6f 74 2d ))....... dot-
a010: 64 61 74 61 29 29 29 0a 09 09 09 09 28 6d 61 70 data))).....(map
a020: 20 28 6c 61 6d 62 64 61 20 28 69 6e 6c 73 74 29 (lambda (inlst)
a030: 0a 09 09 09 09 20 20 20 20 20 20 20 28 64 63 6f ..... (dco
a040: 6d 6d 6f 6e 3a 70 72 6f 63 65 73 73 2d 70 6f 6c mmon:process-pol
a050: 79 6c 69 6e 65 20 0a 09 09 09 09 09 28 6d 61 70 yline ......(map
a060: 20 28 6c 61 6d 62 64 61 20 28 69 6e 73 74 72 29 (lambda (instr)
a070: 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 73 74 ...... (st
a080: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 69 6e 73 ring->number ins
a090: 74 72 29 29 20 3b 3b 20 63 6f 6e 76 65 72 74 20 tr)) ;; convert
a0a0: 74 6f 20 6e 75 6d 62 65 72 20 61 6e 64 20 73 63 to number and sc
a0b0: 61 6c 65 0a 09 09 09 09 09 20 20 20 20 20 28 6c ale...... (l
a0c0: 65 74 20 28 28 69 6c 20 28 63 64 64 64 64 72 20 et ((il (cddddr
a0d0: 69 6e 6c 73 74 29 29 29 0a 09 09 09 09 09 20 20 inlst)))......
a0e0: 20 20 20 20 20 28 74 61 6b 65 20 69 6c 20 28 2d (take il (-
a0f0: 20 28 6c 65 6e 67 74 68 20 69 6c 29 20 32 29 29 (length il) 2))
a100: 29 29 0a 09 09 09 09 09 28 6c 61 6d 62 64 61 20 ))......(lambda
a110: 28 78 20 79 29 0a 09 09 09 09 09 20 20 28 6c 69 (x y)...... (li
a120: 73 74 20 28 2b 20 78 20 30 29 20 20 20 3b 3b 20 st (+ x 0) ;;
a130: 78 74 6f 72 69 67 29 0a 09 09 09 09 09 09 28 2b xtorig).......(+
a140: 20 79 20 30 29 29 29 20 3b 3b 20 79 74 6f 72 69 y 0))) ;; ytori
a150: 67 29 29 29 0a 09 09 09 09 09 23 66 20 23 66 29 g)))......#f #f)
a160: 29 20 3b 3b 20 70 72 6f 63 65 73 73 20 70 6f 6c ) ;; process pol
a170: 79 6c 69 6e 65 0a 09 09 09 09 20 20 20 20 20 65 yline..... e
a180: 64 67 65 73 29 29 29 29 0a 09 09 20 28 63 78 20 dges))))... (cx
a190: 20 20 28 69 66 20 6e 6f 2d 64 6f 74 20 3b 3b 20 (if no-dot ;;
a1a0: 74 68 69 73 20 69 73 20 74 68 65 20 63 65 6e 74 this is the cent
a1b0: 65 72 70 6f 69 6e 74 21 0a 09 09 09 20 20 20 63 erpoint!.... c
a1c0: 75 72 72 2d 78 0a 09 09 09 20 20 20 28 73 74 72 urr-x.... (str
a1d0: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6c 69 73 ing->number (lis
a1e0: 74 2d 72 65 66 20 6e 6f 64 65 64 61 74 20 32 29 t-ref nodedat 2)
a1f0: 29 29 29 0a 09 09 20 28 63 79 20 20 20 28 69 66 )))... (cy (if
a200: 20 6e 6f 2d 64 6f 74 0a 09 09 09 20 20 20 63 75 no-dot.... cu
a210: 72 72 2d 79 0a 09 09 09 20 20 20 28 73 74 72 69 rr-y.... (stri
a220: 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6c 69 73 74 ng->number (list
a230: 2d 72 65 66 20 6e 6f 64 65 64 61 74 20 33 29 29 -ref nodedat 3))
a240: 29 29 0a 09 09 20 28 62 6f 78 77 20 28 69 66 20 ))... (boxw (if
a250: 6e 6f 2d 64 6f 74 0a 09 09 09 20 20 20 62 6f 78 no-dot.... box
a260: 77 0a 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d w.... (string-
a270: 3e 6e 75 6d 62 65 72 20 28 6c 69 73 74 2d 72 65 >number (list-re
a280: 66 20 6e 6f 64 65 64 61 74 20 34 29 29 29 29 0a f nodedat 4)))).
a290: 09 09 20 28 62 6f 78 68 20 28 69 66 20 6e 6f 2d .. (boxh (if no-
a2a0: 64 6f 74 0a 09 09 09 20 20 20 62 6f 78 68 0a 09 dot.... boxh..
a2b0: 09 09 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 .. (string->nu
a2c0: 6d 62 65 72 20 28 6c 69 73 74 2d 72 65 66 20 6e mber (list-ref n
a2d0: 6f 64 65 64 61 74 20 35 29 29 29 29 0a 09 09 20 odedat 5))))...
a2e0: 28 62 6f 78 77 2f 32 20 20 28 2f 20 62 6f 78 77 (boxw/2 (/ boxw
a2f0: 20 32 29 29 0a 09 09 20 28 62 6f 78 68 2f 32 20 2))... (boxh/2
a300: 20 28 2f 20 62 6f 78 68 20 32 29 29 0a 09 09 20 (/ boxh 2))...
a310: 28 75 72 78 20 20 20 20 20 28 2b 20 63 78 20 62 (urx (+ cx b
a320: 6f 78 77 2f 32 29 29 0a 09 09 20 28 75 72 79 20 oxw/2))... (ury
a330: 20 20 20 20 28 2b 20 63 79 20 62 6f 78 68 2f 32 (+ cy boxh/2
a340: 29 29 0a 09 09 20 28 6c 6c 78 20 20 20 20 20 28 ))... (llx (
a350: 2d 20 63 78 20 62 6f 78 77 2f 32 29 29 0a 09 09 - cx boxw/2))...
a360: 20 28 6c 6c 79 20 20 20 20 20 28 2d 20 63 79 20 (lly (- cy
a370: 62 6f 78 68 2f 32 29 29 29 0a 0a 09 20 20 20 20 boxh/2)))...
a380: 3b 3b 20 69 66 20 77 65 20 61 72 65 20 69 6e 20 ;; if we are in
a390: 6e 6f 2d 64 6f 74 20 6d 6f 64 65 20 74 68 65 6e no-dot mode then
a3a0: 20 69 6e 63 72 65 6d 65 6e 74 20 63 75 72 72 2d increment curr-
a3b0: 78 20 61 6e 64 20 63 75 72 72 2d 79 20 61 73 20 x and curr-y as
a3c0: 6e 65 65 64 65 64 0a 09 20 20 20 20 28 69 66 20 needed.. (if
a3d0: 6e 6f 2d 64 6f 74 0a 09 09 28 62 65 67 69 6e 0a no-dot...(begin.
a3e0: 09 09 20 20 28 63 6f 6e 64 20 0a 09 09 20 20 20 .. (cond ...
a3f0: 28 28 3c 20 63 75 72 72 2d 78 20 28 2d 20 73 63 ((< curr-x (- sc
a400: 61 6c 65 64 2d 73 69 7a 65 78 20 62 6f 78 77 20 aled-sizex boxw
a410: 62 6f 78 77 20 6d 61 72 67 69 6e 29 29 0a 09 09 boxw margin))...
a420: 20 20 20 20 28 73 65 74 21 20 63 75 72 72 2d 78 (set! curr-x
a430: 20 28 2b 20 63 75 72 72 2d 78 20 62 6f 78 77 20 (+ curr-x boxw
a440: 6d 61 72 67 69 6e 29 29 29 0a 09 09 20 20 20 28 margin)))... (
a450: 28 3e 20 63 75 72 72 2d 78 20 28 2d 20 73 63 61 (> curr-x (- sca
a460: 6c 65 64 2d 73 69 7a 65 78 20 62 6f 78 77 20 62 led-sizex boxw b
a470: 6f 78 77 20 6d 61 72 67 69 6e 29 29 0a 09 09 20 oxw margin))...
a480: 20 20 20 28 73 65 74 21 20 63 75 72 72 2d 78 20 (set! curr-x
a490: 30 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 63 0)... (set! c
a4a0: 75 72 72 2d 79 20 28 2d 20 63 75 72 72 2d 79 20 urr-y (- curr-y
a4b0: 28 2b 20 62 6f 78 68 20 6d 61 72 67 69 6e 29 29 (+ boxh margin))
a4c0: 29 29 29 29 29 0a 09 09 09 09 09 3b 20 28 70 72 )))))......; (pr
a4d0: 69 6e 74 20 22 68 65 64 20 22 20 68 65 64 20 22 int "hed " hed "
a4e0: 20 6c 6c 78 20 22 20 6c 6c 78 20 22 20 6c 6c 79 llx " llx " lly
a4f0: 20 22 20 6c 6c 79 20 22 20 75 72 78 20 22 20 75 " lly " urx " u
a500: 72 78 20 22 20 75 72 79 20 22 20 75 72 79 29 0a rx " ury " ury).
a510: 09 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 . (dcommon:dr
a520: 61 77 2d 74 65 73 74 20 63 6e 76 20 78 6f 66 66 aw-test cnv xoff
a530: 73 65 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c set yoffset scal
a540: 65 66 20 6c 6c 78 20 6c 6c 79 20 62 6f 78 77 20 ef llx lly boxw
a550: 62 6f 78 68 20 68 65 64 20 28 68 61 73 68 2d 74 boxh hed (hash-t
a560: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
a570: 20 73 65 6c 65 63 74 65 64 2d 74 65 73 74 73 20 selected-tests
a580: 68 65 64 20 23 66 29 29 0a 09 20 20 20 20 3b 3b hed #f)).. ;;
a590: 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 61 (dcommon:draw-a
a5a0: 72 72 6f 77 73 20 63 6e 76 20 74 65 73 74 6e 61 rrows cnv testna
a5b0: 6d 65 20 74 65 73 74 73 2d 69 6e 66 6f 20 74 65 me tests-info te
a5c0: 73 74 2d 72 65 63 6f 72 64 73 29 29 0a 09 20 20 st-records))..
a5d0: 20 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d (dcommon:draw-
a5e0: 65 64 67 65 73 20 63 6e 76 20 78 6f 66 66 73 65 edges cnv xoffse
a5f0: 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c 65 66 t yoffset scalef
a600: 20 65 64 67 65 64 61 74 29 0a 09 20 20 20 20 0a edgedat).. .
a610: 09 20 20 20 20 3b 3b 20 64 61 74 61 20 75 73 65 . ;; data use
a620: 64 20 62 79 20 6d 6f 75 73 65 20 63 6c 69 63 6b d by mouse click
a630: 20 63 61 6c 63 2e 20 6b 65 65 70 20 74 68 65 20 calc. keep the
a640: 77 61 63 6b 79 20 6f 72 64 65 72 20 66 6f 72 20 wacky order for
a650: 6e 6f 77 2e 0a 09 20 20 20 20 28 68 61 73 68 2d now... (hash-
a660: 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 table-set! tests
a670: 2d 69 6e 66 6f 20 68 65 64 20 20 28 6c 69 73 74 -info hed (list
a680: 20 6c 6c 78 20 6c 6c 79 20 75 72 78 20 75 72 79 llx lly urx ury
a690: 20 62 6f 78 77 20 62 6f 78 68 20 65 64 67 65 64 boxw boxh edged
a6a0: 61 74 29 29 20 0a 09 20 20 20 20 28 69 66 20 28 at)) .. (if (
a6b0: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 not (null? tal))
a6c0: 0a 09 09 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 ...(loop (car ta
a6d0: 6c 29 0a 09 09 20 20 20 20 20 20 28 63 64 72 20 l)... (cdr
a6e0: 74 61 6c 29 29 29 29 29 29 0a 20 20 20 20 29 29 tal)))))). ))
a6f0: 0a 0a 3b 3b 20 70 65 72 2d 70 6f 69 6e 74 2d 70 ..;; per-point-p
a700: 72 6f 63 20 72 65 71 75 69 72 65 64 2c 20 72 65 roc required, re
a710: 6d 61 69 6e 64 65 72 20 6f 70 74 69 6f 6e 61 6c mainder optional
a720: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 63 6f .;;.(define (dco
a730: 6d 6d 6f 6e 3a 70 72 6f 63 65 73 73 2d 70 6f 6c mmon:process-pol
a740: 79 6c 69 6e 65 20 6c 69 6e 65 20 70 65 72 2d 70 yline line per-p
a750: 6f 69 6e 74 2d 70 72 6f 63 20 70 65 72 2d 73 65 oint-proc per-se
a760: 67 6d 65 6e 74 2d 70 72 6f 63 20 6c 61 73 74 2d gment-proc last-
a770: 73 65 67 6d 65 6e 74 2d 70 72 6f 63 29 0a 20 20 segment-proc).
a780: 28 69 66 20 28 3c 20 28 6c 65 6e 67 74 68 20 6c (if (< (length l
a790: 69 6e 65 29 20 32 29 0a 20 20 20 20 20 20 27 28 ine) 2). '(
a7a0: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f ). (let loo
a7b0: 70 20 28 28 78 31 20 20 20 28 63 61 72 20 20 6c p ((x1 (car l
a7c0: 69 6e 65 29 29 0a 09 09 20 28 79 31 20 20 20 28 ine))... (y1 (
a7d0: 63 61 64 72 20 6c 69 6e 65 29 29 0a 09 09 20 28 cadr line))... (
a7e0: 78 32 20 20 20 23 66 29 0a 09 09 20 28 79 32 20 x2 #f)... (y2
a7f0: 20 20 23 66 29 0a 09 09 20 28 74 61 6c 20 20 28 #f)... (tal (
a800: 63 64 64 72 20 6c 69 6e 65 29 29 0a 09 09 20 28 cddr line))... (
a810: 72 65 73 20 20 27 28 29 29 29 0a 09 28 69 66 20 res '()))..(if
a820: 28 61 6e 64 20 78 31 20 79 31 20 78 32 20 79 32 (and x1 y1 x2 y2
a830: 20 70 65 72 2d 73 65 67 6d 65 6e 74 2d 70 72 6f per-segment-pro
a840: 63 29 0a 09 20 20 20 20 28 70 65 72 2d 73 65 67 c).. (per-seg
a850: 6d 65 6e 74 2d 70 72 6f 63 20 78 31 20 79 31 20 ment-proc x1 y1
a860: 78 32 20 79 32 29 29 0a 09 28 69 66 20 28 3c 20 x2 y2))..(if (<
a870: 28 6c 65 6e 67 74 68 20 74 61 6c 29 20 32 29 0a (length tal) 2).
a880: 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 . (begin..
a890: 20 20 20 28 69 66 20 6c 61 73 74 2d 73 65 67 6d (if last-segm
a8a0: 65 6e 74 2d 70 72 6f 63 20 28 6c 61 73 74 2d 73 ent-proc (last-s
a8b0: 65 67 6d 65 6e 74 2d 70 72 6f 63 20 78 31 20 79 egment-proc x1 y
a8c0: 31 20 78 32 20 79 32 29 29 0a 09 20 20 20 20 20 1 x2 y2))..
a8d0: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 70 65 (append res (pe
a8e0: 72 2d 70 6f 69 6e 74 2d 70 72 6f 63 20 78 31 20 r-point-proc x1
a8f0: 79 31 29 29 29 0a 09 20 20 20 20 28 6c 6f 6f 70 y1))).. (loop
a900: 20 28 63 61 72 20 74 61 6c 29 28 63 61 64 72 20 (car tal)(cadr
a910: 74 61 6c 29 20 78 31 20 79 31 20 28 63 64 64 72 tal) x1 y1 (cddr
a920: 20 74 61 6c 29 20 28 61 70 70 65 6e 64 20 72 65 tal) (append re
a930: 73 20 28 70 65 72 2d 70 6f 69 6e 74 2d 70 72 6f s (per-point-pro
a940: 63 20 78 31 20 79 31 29 29 29 29 29 29 29 0a 0a c x1 y1)))))))..
a950: 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e (define (dcommon
a960: 3a 72 65 64 72 61 77 2d 74 65 73 74 73 20 63 6e :redraw-tests cn
a970: 76 20 78 61 64 6a 20 79 61 64 6a 20 73 69 7a 65 v xadj yadj size
a980: 78 20 73 69 7a 65 79 20 73 69 7a 65 78 6d 6d 20 x sizey sizexmm
a990: 73 69 7a 65 79 6d 6d 20 6f 72 69 67 69 6e 78 20 sizeymm originx
a9a0: 6f 72 69 67 69 6e 79 20 74 65 73 74 73 2d 64 72 originy tests-dr
a9b0: 61 77 2d 73 74 61 74 65 20 73 6f 72 74 65 64 2d aw-state sorted-
a9c0: 74 65 73 74 6e 61 6d 65 73 20 74 65 73 74 2d 72 testnames test-r
a9d0: 65 63 6f 72 64 73 29 0a 20 20 28 6c 65 74 2a 20 ecords). (let*
a9e0: 28 28 73 63 61 6c 65 66 20 20 20 20 20 20 20 20 ((scalef
a9f0: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
aa00: 65 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 e-ref tests-draw
aa10: 2d 73 74 61 74 65 20 27 73 63 61 6c 65 66 29 29 -state 'scalef))
aa20: 0a 09 20 28 78 6f 66 66 73 65 74 20 20 20 20 20 .. (xoffset
aa30: 20 20 20 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e (dcommon
aa40: 3a 67 65 74 2d 78 6f 66 66 73 65 74 20 74 65 73 :get-xoffset tes
aa50: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 73 69 ts-draw-state si
aa60: 7a 65 78 20 78 61 64 6a 29 29 0a 09 20 28 79 6f zex xadj)).. (yo
aa70: 66 66 73 65 74 20 20 20 20 20 20 20 20 20 20 20 ffset
aa80: 20 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 79 (dcommon:get-y
aa90: 6f 66 66 73 65 74 20 74 65 73 74 73 2d 64 72 61 offset tests-dra
aaa0: 77 2d 73 74 61 74 65 20 73 69 7a 65 79 20 79 61 w-state sizey ya
aab0: 64 6a 29 29 0a 09 20 28 74 65 73 74 73 2d 69 6e dj)).. (tests-in
aac0: 66 6f 20 20 20 20 20 20 20 20 20 20 28 68 61 73 fo (has
aad0: 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 h-table-ref test
aae0: 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 74 65 s-draw-state 'te
aaf0: 73 74 73 2d 69 6e 66 6f 29 29 0a 09 20 28 73 65 sts-info)).. (se
ab00: 6c 65 63 74 65 64 2d 74 65 73 74 73 20 20 20 20 lected-tests
ab10: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
ab20: 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 f tests-draw-sta
ab30: 74 65 20 27 73 65 6c 65 63 74 65 64 2d 74 65 73 te 'selected-tes
ab40: 74 73 20 29 29 29 0a 20 20 20 20 28 69 66 20 28 ts ))). (if (
ab50: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 73 6f 72 74 65 not (null? sorte
ab60: 64 2d 74 65 73 74 6e 61 6d 65 73 29 29 0a 09 28 d-testnames))..(
ab70: 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 let loop ((hed (
ab80: 63 61 72 20 28 72 65 76 65 72 73 65 20 73 6f 72 car (reverse sor
ab90: 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 29 29 29 ted-testnames)))
aba0: 0a 09 09 20 20 20 28 74 61 6c 20 28 63 64 72 20 ... (tal (cdr
abb0: 28 72 65 76 65 72 73 65 20 73 6f 72 74 65 64 2d (reverse sorted-
abc0: 74 65 73 74 6e 61 6d 65 73 29 29 29 29 0a 09 20 testnames))))..
abd0: 20 28 6c 65 74 2a 20 28 28 74 76 61 6c 73 20 28 (let* ((tvals (
abe0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 hash-table-ref t
abf0: 65 73 74 73 2d 69 6e 66 6f 20 68 65 64 29 29 0a ests-info hed)).
ac00: 09 09 20 28 6c 6c 78 20 20 20 28 6c 69 73 74 2d .. (llx (list-
ac10: 72 65 66 20 74 76 61 6c 73 20 30 29 29 0a 09 09 ref tvals 0))...
ac20: 20 28 6c 6c 79 20 20 20 28 6c 69 73 74 2d 72 65 (lly (list-re
ac30: 66 20 74 76 61 6c 73 20 31 29 29 0a 09 09 20 28 f tvals 1))... (
ac40: 62 6f 78 77 20 20 28 6c 69 73 74 2d 72 65 66 20 boxw (list-ref
ac50: 74 76 61 6c 73 20 34 29 29 0a 09 09 20 28 62 6f tvals 4))... (bo
ac60: 78 68 20 20 28 6c 69 73 74 2d 72 65 66 20 74 76 xh (list-ref tv
ac70: 61 6c 73 20 35 29 29 0a 09 09 20 28 65 64 67 65 als 5))... (edge
ac80: 73 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 s (map (lambda (
ac90: 70 6c 69 6e 65 29 0a 09 09 09 20 20 20 20 20 20 pline)....
aca0: 20 28 64 63 6f 6d 6d 6f 6e 3a 70 72 6f 63 65 73 (dcommon:proces
acb0: 73 2d 70 6f 6c 79 6c 69 6e 65 20 70 6c 69 6e 65 s-polyline pline
acc0: 0a 09 09 09 09 09 09 09 20 28 6c 61 6d 62 64 61 ........ (lambda
acd0: 20 28 78 31 20 79 31 29 0a 09 09 09 09 09 09 09 (x1 y1)........
ace0: 20 20 20 28 6c 69 73 74 20 78 31 20 79 31 29 29 (list x1 y1))
acf0: 0a 09 09 09 09 09 09 09 20 23 66 20 23 66 29 29 ........ #f #f))
ad00: 0a 09 09 09 20 20 20 20 20 28 6c 69 73 74 2d 72 .... (list-r
ad10: 65 66 20 74 76 61 6c 73 20 36 29 29 29 0a 09 09 ef tvals 6)))...
ad20: 20 28 75 72 78 20 20 20 28 2b 20 6c 6c 78 20 62 (urx (+ llx b
ad30: 6f 78 77 29 29 0a 09 09 20 28 75 72 79 20 20 20 oxw))... (ury
ad40: 28 2b 20 6c 6c 79 20 62 6f 78 68 29 29 29 0a 09 (+ lly boxh)))..
ad50: 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 (dcommon:dra
ad60: 77 2d 74 65 73 74 20 63 6e 76 20 78 6f 66 66 73 w-test cnv xoffs
ad70: 65 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c 65 et yoffset scale
ad80: 66 20 6c 6c 78 20 6c 6c 79 20 62 6f 78 77 20 62 f llx lly boxw b
ad90: 6f 78 68 20 68 65 64 20 28 68 61 73 68 2d 74 61 oxh hed (hash-ta
ada0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
adb0: 73 65 6c 65 63 74 65 64 2d 74 65 73 74 73 20 68 selected-tests h
adc0: 65 64 20 23 66 29 29 0a 09 20 20 20 20 28 64 63 ed #f)).. (dc
add0: 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 65 64 67 65 73 ommon:draw-edges
ade0: 20 63 6e 76 20 78 6f 66 66 73 65 74 20 79 6f 66 cnv xoffset yof
adf0: 66 73 65 74 20 73 63 61 6c 65 66 20 65 64 67 65 fset scalef edge
ae00: 73 29 0a 09 20 20 20 20 28 69 66 20 28 6e 6f 74 s).. (if (not
ae10: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 (null? tal))...
ae20: 3b 3b 20 6c 65 61 76 65 20 61 20 63 6f 6c 75 6d ;; leave a colum
ae30: 6e 20 6f 66 20 73 70 61 63 65 20 74 6f 20 74 68 n of space to th
ae40: 65 20 72 69 67 68 74 20 74 6f 20 6c 69 73 74 20 e right to list
ae50: 69 74 65 6d 73 0a 09 09 28 6c 6f 6f 70 20 28 63 items...(loop (c
ae60: 61 72 20 74 61 6c 29 0a 09 09 20 20 20 20 20 20 ar tal)...
ae70: 28 63 64 72 20 74 61 6c 29 29 29 29 29 29 29 29 (cdr tal))))))))
ae80: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
ae90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aeb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 55 ==========.;; RU
aed0: 4e 20 43 4f 4e 54 52 4f 4c 53 0a 3b 3b 3d 3d 3d N CONTROLS.;;===
aee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
aef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
af00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
af10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
af20: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 ===..(define (dc
af30: 6f 6d 6d 6f 6e 3a 63 6f 6d 6d 61 6e 64 2d 65 78 ommon:command-ex
af40: 65 63 75 74 69 6f 6e 2d 63 6f 6e 74 72 6f 6c 20 ecution-control
af50: 64 61 74 61 29 0a 20 20 3b 3b 20 54 68 65 20 63 data). ;; The c
af60: 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 64 69 73 70 ommand line disp
af70: 6c 61 79 2f 65 78 65 63 74 75 74 69 6f 6e 20 63 lay/exectution c
af80: 6f 6e 74 72 6f 6c 0a 20 20 28 69 75 70 3a 66 72 ontrol. (iup:fr
af90: 61 6d 65 0a 20 20 20 23 3a 74 69 74 6c 65 20 22 ame. #:title "
afa0: 43 6f 6d 6d 61 6e 64 20 74 6f 20 62 65 20 65 78 Command to be ex
afb0: 65 63 74 75 74 65 64 22 0a 20 20 20 28 69 75 70 ectuted". (iup
afc0: 3a 68 62 6f 78 0a 20 20 20 20 28 69 75 70 3a 6c :hbox. (iup:l
afd0: 61 62 65 6c 20 22 52 75 6e 20 6f 6e 22 20 23 3a abel "Run on" #:
afe0: 73 69 7a 65 20 22 34 30 78 22 29 0a 20 20 20 20 size "40x").
aff0: 28 69 75 70 3a 72 61 64 69 6f 20 0a 20 20 20 20 (iup:radio .
b000: 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20 20 20 (iup:hbox.
b010: 20 28 69 75 70 3a 74 6f 67 67 6c 65 20 22 4c 6f (iup:toggle "Lo
b020: 63 61 6c 22 20 23 3a 73 69 7a 65 20 22 34 30 78 cal" #:size "40x
b030: 22 29 0a 20 20 20 20 20 20 28 69 75 70 3a 74 6f "). (iup:to
b040: 67 67 6c 65 20 22 53 65 72 76 65 72 22 20 23 3a ggle "Server" #:
b050: 73 69 7a 65 20 22 34 30 78 22 29 29 29 0a 20 20 size "40x"))).
b060: 20 20 28 6c 65 74 20 28 28 74 62 20 28 69 75 70 (let ((tb (iup
b070: 3a 74 65 78 74 62 6f 78 20 0a 09 20 20 20 20 20 :textbox ..
b080: 20 20 23 3a 76 61 6c 75 65 20 22 6d 65 67 61 74 #:value "megat
b090: 65 73 74 20 22 0a 09 20 20 20 20 20 20 20 23 3a est ".. #:
b0a0: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT
b0b0: 41 4c 22 0a 09 20 20 20 20 20 20 20 23 3a 72 65 AL".. #:re
b0c0: 61 64 6f 6e 6c 79 20 22 59 45 53 22 0a 09 20 20 adonly "YES"..
b0d0: 20 20 20 20 20 23 3a 66 6f 6e 74 20 22 43 6f 75 #:font "Cou
b0e0: 72 69 65 72 20 4e 65 77 2c 20 2d 31 32 22 0a 09 rier New, -12"..
b0f0: 20 20 20 20 20 20 20 29 29 29 0a 20 20 20 20 20 ))).
b100: 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d (dboard:tabdat-
b110: 63 6f 6d 6d 61 6e 64 2d 74 62 2d 73 65 74 21 20 command-tb-set!
b120: 64 61 74 61 20 74 62 29 0a 20 20 20 20 20 20 74 data tb). t
b130: 62 29 0a 20 20 20 20 28 69 75 70 3a 62 75 74 74 b). (iup:butt
b140: 6f 6e 20 22 45 78 65 63 75 74 65 22 20 23 3a 73 on "Execute" #:s
b150: 69 7a 65 20 22 35 30 78 22 0a 09 09 23 3a 61 63 ize "50x"...#:ac
b160: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 tion (lambda (ob
b170: 6a 29 0a 09 09 09 20 20 20 3b 3b 20 28 6c 65 74 j).... ;; (let
b180: 20 28 28 63 6d 64 20 28 63 6f 6e 63 20 3b 3b 20 ((cmd (conc ;;
b190: 22 78 74 65 72 6d 20 2d 67 65 6f 6d 65 74 72 79 "xterm -geometry
b1a0: 20 31 38 30 78 32 30 20 2d 65 20 5c 22 22 0a 20 180x20 -e \"".
b1b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b1c0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f (commo
b1d0: 6e 3a 72 75 6e 2d 61 2d 63 6f 6d 6d 61 6e 64 20 n:run-a-command
b1e0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 28 (iup:attribute (
b1f0: 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 63 6f dboard:tabdat-co
b200: 6d 6d 61 6e 64 2d 74 62 20 64 61 74 61 29 20 22 mmand-tb data) "
b210: 56 41 4c 55 45 22 29 29 29 29 29 29 29 0a 20 20 VALUE"))))))).
b220: 20 20 3b 3b 20 22 3b 65 63 68 6f 20 50 72 65 73 ;; ";echo Pres
b230: 73 20 61 6e 79 20 6b 65 79 20 74 6f 20 63 6f 6e s any key to con
b240: 74 69 6e 75 65 3b 62 61 73 68 20 2d 63 20 27 72 tinue;bash -c 'r
b250: 65 61 64 20 2d 6e 20 31 20 2d 73 27 5c 22 20 26 ead -n 1 -s'\" &
b260: 22 29 29 29 0a 20 20 20 20 3b 3b 20 28 73 79 73 "))). ;; (sys
b270: 74 65 6d 20 63 6d 64 29 29 29 29 29 29 29 0a 0a tem cmd)))))))..
b280: 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e (define (dcommon
b290: 3a 63 6f 6d 6d 61 6e 64 2d 61 63 74 69 6f 6e 2d :command-action-
b2a0: 73 65 6c 65 63 74 6f 72 20 63 6f 6d 6d 6f 6e 64 selector commond
b2b0: 61 74 20 74 61 62 64 61 74 20 23 21 6b 65 79 20 at tabdat #!key
b2c0: 28 74 61 62 2d 6e 75 6d 20 23 66 29 29 0a 20 20 (tab-num #f)).
b2d0: 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 20 23 3a (iup:frame. #:
b2e0: 74 69 74 6c 65 20 22 53 65 74 20 74 68 65 20 61 title "Set the a
b2f0: 63 74 69 6f 6e 20 74 6f 20 74 61 6b 65 22 0a 20 ction to take".
b300: 20 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20 20 (iup:hbox.
b310: 3b 3b 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 43 ;; (iup:label "C
b320: 6f 6d 6d 61 6e 64 20 74 6f 20 72 75 6e 22 20 23 ommand to run" #
b330: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
b340: 54 41 4c 22 20 23 3a 73 69 7a 65 20 22 37 30 78 TAL" #:size "70x
b350: 22 20 23 3a 61 6c 69 67 6e 6d 65 6e 74 20 22 4c " #:alignment "L
b360: 45 46 54 3a 41 43 45 4e 54 45 52 22 29 0a 20 20 EFT:ACENTER").
b370: 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 73 2d 6c (let* ((cmds-l
b380: 69 73 74 20 27 28 22 72 75 6e 22 20 22 72 65 6d ist '("run" "rem
b390: 6f 76 65 2d 72 75 6e 73 22 29 29 20 3b 3b 20 20 ove-runs")) ;;
b3a0: 22 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 "set-state-statu
b3b0: 73 22 20 22 6c 6f 63 6b 2d 72 75 6e 73 22 20 22 s" "lock-runs" "
b3c0: 75 6e 6c 6f 63 6b 2d 72 75 6e 73 22 29 29 0a 09 unlock-runs"))..
b3d0: 20 20 20 28 6c 62 20 20 20 20 20 20 20 20 20 28 (lb (
b3e0: 69 75 70 3a 6c 69 73 74 62 6f 78 20 23 3a 65 78 iup:listbox #:ex
b3f0: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL
b400: 22 0a 09 09 09 09 20 20 20 20 23 3a 64 72 6f 70 "..... #:drop
b410: 64 6f 77 6e 20 22 59 45 53 22 0a 09 09 09 09 20 down "YES".....
b420: 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d #:action (lam
b430: 62 64 61 20 28 6f 62 6a 20 76 61 6c 20 69 6e 64 bda (obj val ind
b440: 65 78 20 6c 62 73 74 61 74 65 29 0a 09 09 09 09 ex lbstate).....
b450: 09 20 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e . ;; (prin
b460: 74 20 6f 62 6a 20 22 20 22 20 76 61 6c 20 22 20 t obj " " val "
b470: 22 20 69 6e 64 65 78 20 22 20 22 20 6c 62 73 74 " index " " lbst
b480: 61 74 65 29 0a 09 09 09 09 09 20 20 20 20 20 20 ate)......
b490: 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d (dboard:tabdat-
b4a0: 63 6f 6d 6d 61 6e 64 2d 73 65 74 21 20 74 61 62 command-set! tab
b4b0: 64 61 74 20 76 61 6c 29 0a 09 09 09 09 09 20 20 dat val)......
b4c0: 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a (dashboard:
b4d0: 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 update-run-comma
b4e0: 6e 64 20 74 61 62 64 61 74 29 29 29 29 0a 09 20 nd tabdat))))..
b4f0: 20 20 28 64 65 66 61 75 6c 74 2d 63 6d 64 20 28 (default-cmd (
b500: 63 61 72 20 63 6d 64 73 2d 6c 69 73 74 29 29 29 car cmds-list)))
b510: 0a 20 20 20 20 20 20 28 69 75 70 6c 69 73 74 62 . (iuplistb
b520: 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 20 ox-fill-list lb
b530: 63 6d 64 73 2d 6c 69 73 74 20 73 65 6c 65 63 74 cmds-list select
b540: 65 64 2d 69 74 65 6d 3a 20 64 65 66 61 75 6c 74 ed-item: default
b550: 2d 63 6d 64 29 0a 20 20 20 20 20 20 28 64 62 6f -cmd). (dbo
b560: 61 72 64 3a 74 61 62 64 61 74 2d 63 6f 6d 6d 61 ard:tabdat-comma
b570: 6e 64 2d 73 65 74 21 20 74 61 62 64 61 74 20 64 nd-set! tabdat d
b580: 65 66 61 75 6c 74 2d 63 6d 64 29 0a 20 20 20 20 efault-cmd).
b590: 20 20 6c 62 29 29 29 29 0a 0a 28 64 65 66 69 6e lb))))..(defin
b5a0: 65 20 28 64 63 6f 6d 6d 6f 6e 3a 63 6f 6d 6d 61 e (dcommon:comma
b5b0: 6e 64 2d 72 75 6e 6e 61 6d 65 2d 73 65 6c 65 63 nd-runname-selec
b5c0: 74 6f 72 20 63 6f 6d 6d 6f 6e 64 61 74 20 74 61 tor commondat ta
b5d0: 62 64 61 74 20 23 21 6b 65 79 20 28 74 61 62 2d bdat #!key (tab-
b5e0: 6e 75 6d 20 23 66 29 29 20 3b 3b 20 61 6c 6c 64 num #f)) ;; alld
b5f0: 61 74 20 64 61 74 61 29 0a 20 20 28 69 75 70 3a at data). (iup:
b600: 66 72 61 6d 65 0a 20 20 20 23 3a 74 69 74 6c 65 frame. #:title
b610: 20 22 52 75 6e 6e 61 6d 65 22 0a 20 20 20 28 6c "Runname". (l
b620: 65 74 2a 20 28 28 64 65 66 61 75 6c 74 2d 72 75 et* ((default-ru
b630: 6e 2d 6e 61 6d 65 20 28 73 65 63 6f 6e 64 73 2d n-name (seconds-
b640: 3e 77 6f 72 6b 2d 77 65 65 6b 2f 64 61 79 20 28 >work-week/day (
b650: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
b660: 29 29 0a 09 20 20 28 74 62 20 28 69 75 70 3a 74 )).. (tb (iup:t
b670: 65 78 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 extbox #:expand
b680: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 "HORIZONTAL"....
b690: 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d #:action (lam
b6a0: 62 64 61 20 28 6f 62 6a 20 76 61 6c 20 74 78 74 bda (obj val txt
b6b0: 29 0a 09 09 09 09 20 20 20 20 20 20 28 64 65 62 )..... (deb
b6c0: 75 67 3a 63 61 74 63 68 2d 61 6e 64 2d 64 75 6d ug:catch-and-dum
b6d0: 70 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c 61 p..... (la
b6e0: 6d 62 64 61 20 28 29 0a 09 09 09 09 09 20 3b 3b mbda ()...... ;;
b6f0: 20 28 70 72 69 6e 74 20 22 6f 62 6a 3a 20 22 20 (print "obj: "
b700: 6f 62 6a 20 22 20 76 61 6c 3a 20 22 20 76 61 6c obj " val: " val
b710: 20 22 20 75 6e 6b 3a 20 22 20 75 6e 6b 29 0a 09 " unk: " unk)..
b720: 09 09 09 09 20 28 64 62 6f 61 72 64 3a 74 61 62 .... (dboard:tab
b730: 64 61 74 2d 72 75 6e 2d 6e 61 6d 65 2d 73 65 74 dat-run-name-set
b740: 21 20 74 61 62 64 61 74 20 74 78 74 29 20 3b 3b ! tabdat txt) ;;
b750: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute
b760: 6f 62 6a 20 22 56 41 4c 55 45 22 29 29 0a 09 09 obj "VALUE"))...
b770: 09 09 09 20 28 64 61 73 68 62 6f 61 72 64 3a 75 ... (dashboard:u
b780: 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 6e pdate-run-comman
b790: 64 20 74 61 62 64 61 74 29 29 0a 09 09 09 09 20 d tabdat)).....
b7a0: 20 20 20 20 20 20 22 63 6f 6d 6d 61 6e 64 2d 72 "command-r
b7b0: 75 6e 6e 61 6d 65 2d 73 65 6c 65 63 74 6f 72 20 unname-selector
b7c0: 74 62 20 61 63 74 69 6f 6e 22 29 29 0a 09 09 09 tb action"))....
b7d0: 20 20 20 23 3a 76 61 6c 75 65 20 28 6f 72 20 64 #:value (or d
b7e0: 65 66 61 75 6c 74 2d 72 75 6e 2d 6e 61 6d 65 20 efault-run-name
b7f0: 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 72 (dboard:tabdat-r
b800: 75 6e 2d 6e 61 6d 65 20 74 61 62 64 61 74 29 29 un-name tabdat))
b810: 29 29 0a 09 20 20 28 6c 62 20 28 69 75 70 3a 6c )).. (lb (iup:l
b820: 69 73 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 istbox #:expand
b830: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 "HORIZONTAL"....
b840: 20 20 20 23 3a 64 72 6f 70 64 6f 77 6e 20 22 59 #:dropdown "Y
b850: 45 53 22 0a 09 09 09 20 20 20 23 3a 61 63 74 69 ES".... #:acti
b860: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 on (lambda (obj
b870: 76 61 6c 20 69 6e 64 65 78 20 6c 62 73 74 61 74 val index lbstat
b880: 65 29 0a 09 09 09 09 20 20 20 20 20 20 28 64 65 e)..... (de
b890: 62 75 67 3a 63 61 74 63 68 2d 61 6e 64 2d 64 75 bug:catch-and-du
b8a0: 6d 70 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c mp..... (l
b8b0: 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 20 28 ambda ()...... (
b8c0: 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 if (not (equal?
b8d0: 76 61 6c 20 22 22 29 29 0a 09 09 09 09 09 20 20 val ""))......
b8e0: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 (begin......
b8f0: 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 (iup:attri
b900: 62 75 74 65 2d 73 65 74 21 20 74 62 20 22 56 41 bute-set! tb "VA
b910: 4c 55 45 22 20 76 61 6c 29 0a 09 09 09 09 09 20 LUE" val)......
b920: 20 20 20 20 20 20 28 64 62 6f 61 72 64 3a 74 61 (dboard:ta
b930: 62 64 61 74 2d 72 75 6e 2d 6e 61 6d 65 2d 73 65 bdat-run-name-se
b940: 74 21 20 74 61 62 64 61 74 20 76 61 6c 29 0a 09 t! tabdat val)..
b950: 09 09 09 09 20 20 20 20 20 20 20 28 64 61 73 68 .... (dash
b960: 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72 75 6e board:update-run
b970: 2d 63 6f 6d 6d 61 6e 64 20 74 61 62 64 61 74 29 -command tabdat)
b980: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 22 )))..... "
b990: 63 6f 6d 6d 61 6e 64 2d 72 75 6e 6e 61 6d 65 2d command-runname-
b9a0: 73 65 6c 65 63 74 6f 72 20 6c 62 20 61 63 74 69 selector lb acti
b9b0: 6f 6e 22 29 29 29 29 0a 09 20 20 28 72 65 66 72 on")))).. (refr
b9c0: 65 73 68 2d 72 75 6e 73 2d 6c 69 73 74 20 28 6c esh-runs-list (l
b9d0: 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 20 ambda ()....
b9e0: 20 20 20 28 69 66 20 28 64 61 73 68 62 6f 61 72 (if (dashboar
b9f0: 64 3a 64 61 74 61 62 61 73 65 2d 63 68 61 6e 67 d:database-chang
ba00: 65 64 3f 20 63 6f 6d 6d 6f 6e 64 61 74 20 74 61 ed? commondat ta
ba10: 62 64 61 74 20 63 6f 6e 74 65 78 74 2d 6b 65 79 bdat context-key
ba20: 3a 20 27 72 75 6e 6e 61 6d 65 2d 73 65 6c 65 63 : 'runname-selec
ba30: 74 6f 72 2d 72 75 6e 73 2d 6c 69 73 74 29 0a 09 tor-runs-list)..
ba40: 09 09 09 20 20 20 28 6c 65 74 2a 20 28 3b 3b 20 ... (let* (;;
ba50: 28 74 61 72 67 65 74 20 20 20 20 20 20 20 20 28 (target (
ba60: 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 74 61 dboard:tabdat-ta
ba70: 72 67 65 74 2d 73 74 72 69 6e 67 20 74 61 62 64 rget-string tabd
ba80: 61 74 29 29 0a 09 09 09 09 09 20 20 28 72 75 6e at))...... (run
ba90: 73 2d 66 6f 72 2d 74 61 72 67 20 28 72 6d 74 3a s-for-targ (rmt:
baa0: 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 get-runs-by-patt
bab0: 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d (dboard:tabdat-
bac0: 6b 65 79 73 20 74 61 62 64 61 74 29 20 22 25 22 keys tabdat) "%"
bad0: 20 23 66 20 23 66 20 23 66 20 23 66 20 30 29 29 #f #f #f #f 0))
bae0: 0a 09 09 09 09 09 20 20 28 72 75 6e 73 2d 68 65 ...... (runs-he
baf0: 61 64 65 72 20 20 20 28 76 65 63 74 6f 72 2d 72 ader (vector-r
bb00: 65 66 20 72 75 6e 73 2d 66 6f 72 2d 74 61 72 67 ef runs-for-targ
bb10: 20 30 29 29 0a 09 09 09 09 09 20 20 28 72 75 6e 0))...... (run
bb20: 73 2d 64 61 74 20 20 20 20 20 20 28 76 65 63 74 s-dat (vect
bb30: 6f 72 2d 72 65 66 20 72 75 6e 73 2d 66 6f 72 2d or-ref runs-for-
bb40: 74 61 72 67 20 31 29 29 0a 09 09 09 09 09 20 20 targ 1))......
bb50: 28 72 75 6e 2d 6e 61 6d 65 73 20 20 20 20 20 28 (run-names (
bb60: 63 6f 6e 73 20 64 65 66 61 75 6c 74 2d 72 75 6e cons default-run
bb70: 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 20 20 -name ........
bb80: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
bb90: 61 20 28 78 29 0a 09 09 09 09 09 09 09 09 20 20 a (x).........
bba0: 20 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 (db:get-valu
bbb0: 65 2d 62 79 2d 68 65 61 64 65 72 20 78 20 72 75 e-by-header x ru
bbc0: 6e 73 2d 68 65 61 64 65 72 20 22 72 75 6e 6e 61 ns-header "runna
bbd0: 6d 65 22 29 29 0a 09 09 09 09 09 09 09 09 20 20 me")).........
bbe0: 20 20 72 75 6e 73 2d 64 61 74 29 29 29 29 0a 09 runs-dat))))..
bbf0: 09 09 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e ... ;; (prin
bc00: 74 20 22 44 45 42 55 47 49 4e 46 4f 3a 20 72 75 t "DEBUGINFO: ru
bc10: 6e 2d 6e 61 6d 65 73 3d 22 20 72 75 6e 2d 6e 61 n-names=" run-na
bc20: 6d 65 73 29 0a 09 09 09 09 20 20 20 20 20 3b 3b mes)..... ;;
bc30: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
bc40: 73 65 74 21 20 6c 62 20 22 52 45 4d 4f 56 45 49 set! lb "REMOVEI
bc50: 54 45 4d 22 20 22 41 4c 4c 22 29 0a 09 09 09 09 TEM" "ALL").....
bc60: 20 20 20 20 20 28 69 75 70 6c 69 73 74 62 6f 78 (iuplistbox
bc70: 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 20 72 75 -fill-list lb ru
bc80: 6e 2d 6e 61 6d 65 73 20 73 65 6c 65 63 74 65 64 n-names selected
bc90: 2d 69 74 65 6d 3a 20 64 65 66 61 75 6c 74 2d 72 -item: default-r
bca0: 75 6e 2d 6e 61 6d 65 29 29 29 29 29 29 0a 20 20 un-name)))))).
bcb0: 20 20 20 3b 3b 20 28 64 62 6f 61 72 64 3a 74 61 ;; (dboard:ta
bcc0: 62 64 61 74 2d 75 70 64 61 74 65 72 2d 66 6f 72 bdat-updater-for
bcd0: 2d 72 75 6e 73 2d 73 65 74 21 20 74 61 62 64 61 -runs-set! tabda
bce0: 74 20 72 65 66 72 65 73 68 2d 72 75 6e 73 2d 6c t refresh-runs-l
bcf0: 69 73 74 29 0a 20 20 20 20 20 28 64 62 6f 61 72 ist). (dboar
bd00: 64 3a 63 6f 6d 6d 6f 6e 64 61 74 2d 61 64 64 2d d:commondat-add-
bd10: 75 70 64 61 74 65 72 20 63 6f 6d 6d 6f 6e 64 61 updater commonda
bd20: 74 20 72 65 66 72 65 73 68 2d 72 75 6e 73 2d 6c t refresh-runs-l
bd30: 69 73 74 20 74 61 62 2d 6e 75 6d 3a 20 74 61 62 ist tab-num: tab
bd40: 2d 6e 75 6d 29 0a 20 20 20 20 20 3b 3b 20 28 72 -num). ;; (r
bd50: 65 66 72 65 73 68 2d 72 75 6e 73 2d 6c 69 73 74 efresh-runs-list
bd60: 29 0a 20 20 20 20 20 28 64 62 6f 61 72 64 3a 74 ). (dboard:t
bd70: 61 62 64 61 74 2d 72 75 6e 2d 6e 61 6d 65 2d 73 abdat-run-name-s
bd80: 65 74 21 20 74 61 62 64 61 74 20 64 65 66 61 75 et! tabdat defau
bd90: 6c 74 2d 72 75 6e 2d 6e 61 6d 65 29 0a 20 20 20 lt-run-name).
bda0: 20 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20 20 (iup:hbox.
bdb0: 20 20 74 62 0a 20 20 20 20 20 20 6c 62 29 29 29 tb. lb)))
bdc0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d )..(define (dcom
bdd0: 6d 6f 6e 3a 63 6f 6d 6d 61 6e 64 2d 74 65 73 74 mon:command-test
bde0: 6e 61 6d 65 2d 73 65 6c 65 63 74 6f 72 20 63 6f name-selector co
bdf0: 6d 6d 6f 6e 64 61 74 20 74 61 62 64 61 74 20 75 mmondat tabdat u
be00: 70 64 61 74 65 2d 6b 65 79 76 61 6c 73 29 20 3b pdate-keyvals) ;
be10: 3b 20 20 6b 65 79 2d 6c 69 73 74 62 6f 78 65 73 ; key-listboxes
be20: 29 0a 20 20 28 69 75 70 3a 76 62 6f 78 0a 20 20 ). (iup:vbox.
be30: 20 3b 3b 20 54 65 78 74 20 62 6f 78 20 66 6f 72 ;; Text box for
be40: 20 74 65 73 74 20 70 61 74 74 65 72 6e 73 0a 20 test patterns.
be50: 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 20 (iup:frame.
be60: 20 23 3a 74 69 74 6c 65 20 22 54 65 73 74 20 70 #:title "Test p
be70: 61 74 74 65 72 6e 73 20 28 6f 6e 65 20 70 65 72 atterns (one per
be80: 20 6c 69 6e 65 29 22 0a 20 20 20 20 28 6c 65 74 line)". (let
be90: 20 28 28 74 62 20 28 69 75 70 3a 74 65 78 74 62 ((tb (iup:textb
bea0: 6f 78 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d ox #:action (lam
beb0: 62 64 61 20 28 76 61 6c 20 61 20 62 29 0a 09 09 bda (val a b)...
bec0: 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 63 .. (debug:c
bed0: 61 74 63 68 2d 61 6e 64 2d 64 75 6d 70 0a 09 09 atch-and-dump...
bee0: 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
bef0: 20 28 29 0a 09 09 09 09 09 20 28 64 62 6f 61 72 ()...... (dboar
bf00: 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d 70 61 d:tabdat-test-pa
bf10: 74 74 73 2d 73 65 74 21 2d 75 73 65 0a 09 09 09 tts-set!-use....
bf20: 09 09 20 20 74 61 62 64 61 74 0a 09 09 09 09 09 .. tabdat......
bf30: 20 20 28 64 62 6f 61 72 64 3a 6c 69 6e 65 73 2d (dboard:lines-
bf40: 3e 74 65 73 74 2d 70 61 74 74 20 62 29 29 0a 09 >test-patt b))..
bf50: 09 09 09 09 20 28 64 61 73 68 62 6f 61 72 64 3a .... (dashboard:
bf60: 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 update-run-comma
bf70: 6e 64 20 74 61 62 64 61 74 29 29 0a 09 09 09 09 nd tabdat)).....
bf80: 20 20 20 20 20 20 20 22 63 6f 6d 6d 61 6e 64 2d "command-
bf90: 74 65 73 74 6e 61 6d 65 2d 73 65 6c 65 63 74 6f testname-selecto
bfa0: 72 20 74 62 20 61 63 74 69 6f 6e 22 29 29 0a 09 r tb action"))..
bfb0: 09 09 20 20 20 23 3a 76 61 6c 75 65 20 28 64 62 .. #:value (db
bfc0: 6f 61 72 64 3a 74 65 73 74 2d 70 61 74 74 2d 3e oard:test-patt->
bfd0: 6c 69 6e 65 73 0a 09 09 09 09 20 20 20 20 28 64 lines..... (d
bfe0: 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 74 65 73 board:tabdat-tes
bff0: 74 2d 70 61 74 74 73 2d 75 73 65 20 74 61 62 64 t-patts-use tabd
c000: 61 74 29 29 0a 09 09 09 20 20 20 23 3a 65 78 70 at)).... #:exp
c010: 61 6e 64 20 22 59 45 53 22 0a 09 09 09 20 20 20 and "YES"....
c020: 23 3a 73 69 7a 65 20 22 78 33 30 22 20 3b 3b 20 #:size "x30" ;;
c030: 77 61 73 20 31 30 78 33 30 0a 09 09 09 20 20 20 was 10x30....
c040: 23 3a 6d 75 6c 74 69 6c 69 6e 65 20 22 59 45 53 #:multiline "YES
c050: 22 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 "))). (set!
c060: 20 74 65 73 74 2d 70 61 74 74 65 72 6e 73 2d 74 test-patterns-t
c070: 65 78 74 62 6f 78 20 74 62 29 0a 20 20 20 20 20 extbox tb).
c080: 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d (dboard:tabdat-
c090: 74 65 73 74 2d 70 61 74 74 65 72 6e 73 2d 74 65 test-patterns-te
c0a0: 78 74 62 6f 78 2d 73 65 74 21 20 74 61 62 64 61 xtbox-set! tabda
c0b0: 74 20 74 62 29 0a 20 20 20 20 20 20 74 62 29 29 t tb). tb))
c0c0: 0a 3b 3b 20 28 69 75 70 3a 66 72 61 6d 65 0a 3b .;; (iup:frame.;
c0d0: 3b 20 20 23 3a 74 69 74 6c 65 20 22 54 61 72 67 ; #:title "Targ
c0e0: 65 74 22 0a 3b 3b 20 20 3b 3b 20 54 61 72 67 65 et".;; ;; Targe
c0f0: 74 20 73 65 6c 65 63 74 6f 72 73 0a 3b 3b 20 20 t selectors.;;
c100: 28 61 70 70 6c 79 20 69 75 70 3a 68 62 6f 78 0a (apply iup:hbox.
c110: 3b 3b 20 09 20 20 20 28 6c 65 74 2a 20 28 28 64 ;; . (let* ((d
c120: 61 74 20 20 20 20 20 20 28 64 61 73 68 62 6f 61 at (dashboa
c130: 72 64 3a 75 70 64 61 74 65 2d 74 61 72 67 65 74 rd:update-target
c140: 2d 73 65 6c 65 63 74 6f 72 20 74 61 62 64 61 74 -selector tabdat
c150: 20 61 63 74 69 6f 6e 2d 70 72 6f 63 3a 20 75 70 action-proc: up
c160: 64 61 74 65 2d 6b 65 79 76 61 6c 73 29 29 0a 3b date-keyvals)).;
c170: 3b 20 09 09 20 20 28 6b 65 79 2d 6c 62 20 20 20 ; .. (key-lb
c180: 28 63 61 72 20 64 61 74 29 29 0a 3b 3b 20 09 09 (car dat)).;; ..
c190: 20 20 28 63 6f 6d 62 6f 73 20 20 20 28 63 61 64 (combos (cad
c1a0: 72 20 64 61 74 29 29 29 0a 3b 3b 20 09 20 20 20 r dat))).;; .
c1b0: 20 20 63 6f 6d 62 6f 73 29 29 29 0a 20 20 20 3b combos))). ;
c1c0: 3b 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20 3b ; (iup:hbox. ;
c1d0: 3b 20 20 3b 3b 20 54 65 78 74 20 62 6f 78 20 66 ; ;; Text box f
c1e0: 6f 72 20 53 54 41 54 45 53 0a 20 20 20 3b 3b 20 or STATES. ;;
c1f0: 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 20 3b (iup:frame. ;
c200: 3b 20 20 20 23 3a 74 69 74 6c 65 20 22 53 74 61 ; #:title "Sta
c210: 74 65 73 22 0a 20 20 20 3b 3b 20 20 20 28 64 61 tes". ;; (da
c220: 73 68 62 6f 61 72 64 3a 74 65 78 74 2d 6c 69 73 shboard:text-lis
c230: 74 2d 74 6f 67 67 6c 65 2d 62 6f 78 20 0a 20 20 t-toggle-box .
c240: 20 3b 3b 20 20 20 20 3b 3b 20 4d 6f 76 65 20 74 ;; ;; Move t
c250: 68 65 73 65 20 64 65 66 69 6e 69 74 69 6f 6e 73 hese definitions
c260: 20 74 6f 20 63 6f 6d 6d 6f 6e 20 61 6e 64 20 66 to common and f
c270: 69 6e 64 20 74 68 65 20 6f 74 68 65 72 20 75 73 ind the other us
c280: 65 61 67 65 73 20 61 6e 64 20 72 65 70 6c 61 63 eages and replac
c290: 65 21 0a 20 20 20 3b 3b 20 20 20 20 28 6d 61 70 e!. ;; (map
c2a0: 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 cadr *common:st
c2b0: 64 2d 73 74 61 74 65 73 2a 29 20 3b 3b 20 27 28 d-states*) ;; '(
c2c0: 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 52 55 4e "COMPLETED" "RUN
c2d0: 4e 49 4e 47 22 20 22 53 54 55 43 4b 22 20 22 49 NING" "STUCK" "I
c2e0: 4e 43 4f 4d 50 4c 45 54 45 22 20 22 4c 41 55 4e NCOMPLETE" "LAUN
c2f0: 43 48 45 44 22 20 22 52 45 4d 4f 54 45 48 4f 53 CHED" "REMOTEHOS
c300: 54 53 54 41 52 54 22 20 22 4b 49 4c 4c 45 44 22 TSTART" "KILLED"
c310: 29 0a 20 20 20 3b 3b 20 20 20 20 28 6c 61 6d 62 ). ;; (lamb
c320: 64 61 20 28 61 6c 6c 29 0a 20 20 20 3b 3b 20 20 da (all). ;;
c330: 20 20 20 20 28 64 62 6f 61 72 64 3a 74 61 62 64 (dboard:tabd
c340: 61 74 2d 73 74 61 74 65 73 2d 73 65 74 21 20 74 at-states-set! t
c350: 61 62 64 61 74 20 61 6c 6c 29 0a 20 20 20 3b 3b abdat all). ;;
c360: 20 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 (dashboard
c370: 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d :update-run-comm
c380: 61 6e 64 20 74 61 62 64 61 74 29 29 29 29 0a 20 and tabdat)))).
c390: 20 20 3b 3b 20 20 3b 3b 20 54 65 78 74 20 62 6f ;; ;; Text bo
c3a0: 78 20 66 6f 72 20 53 54 41 54 45 53 0a 20 20 20 x for STATES.
c3b0: 3b 3b 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 ;; (iup:frame.
c3c0: 20 20 3b 3b 20 20 20 23 3a 74 69 74 6c 65 20 22 ;; #:title "
c3d0: 53 74 61 74 75 73 65 73 22 0a 20 20 20 3b 3b 20 Statuses". ;;
c3e0: 20 20 28 64 61 73 68 62 6f 61 72 64 3a 74 65 78 (dashboard:tex
c3f0: 74 2d 6c 69 73 74 2d 74 6f 67 67 6c 65 2d 62 6f t-list-toggle-bo
c400: 78 20 0a 20 20 20 3b 3b 20 20 20 20 28 6d 61 70 x . ;; (map
c410: 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 cadr *common:st
c420: 64 2d 73 74 61 74 75 73 65 73 2a 29 20 3b 3b 20 d-statuses*) ;;
c430: 27 28 22 50 41 53 53 22 20 22 46 41 49 4c 22 20 '("PASS" "FAIL"
c440: 22 6e 2f 61 22 20 22 43 48 45 43 4b 22 20 22 57 "n/a" "CHECK" "W
c450: 41 49 56 45 44 22 20 22 53 4b 49 50 22 20 22 44 AIVED" "SKIP" "D
c460: 45 4c 45 54 45 44 22 20 22 53 54 55 43 4b 2f 44 ELETED" "STUCK/D
c470: 45 41 44 22 29 0a 20 20 20 3b 3b 20 20 20 20 28 EAD"). ;; (
c480: 6c 61 6d 62 64 61 20 28 61 6c 6c 29 0a 20 20 20 lambda (all).
c490: 3b 3b 20 20 20 20 20 20 28 64 62 6f 61 72 64 3a ;; (dboard:
c4a0: 74 61 62 64 61 74 2d 73 74 61 74 75 73 65 73 2d tabdat-statuses-
c4b0: 73 65 74 21 20 74 61 62 64 61 74 20 61 6c 6c 29 set! tabdat all)
c4c0: 0a 20 20 20 3b 3b 20 20 20 20 20 20 28 64 61 73 . ;; (das
c4d0: 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72 75 hboard:update-ru
c4e0: 6e 2d 63 6f 6d 6d 61 6e 64 20 74 61 62 64 61 74 n-command tabdat
c4f0: 29 29 29 29 29 0a 20 20 20 29 29 0a 0a 28 64 65 ))))). ))..(de
c500: 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 63 6f fine (dcommon:co
c510: 6d 6d 61 6e 64 2d 74 65 73 74 73 2d 74 61 73 6b mmand-tests-task
c520: 73 2d 63 61 6e 76 61 73 20 74 61 62 64 61 74 20 s-canvas tabdat
c530: 74 65 73 74 2d 72 65 63 6f 72 64 73 20 73 6f 72 test-records sor
c540: 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 20 74 65 ted-testnames te
c550: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 29 0a sts-draw-state).
c560: 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 20 (iup:frame.
c570: 23 3a 74 69 74 6c 65 20 22 54 65 73 74 73 20 61 #:title "Tests a
c580: 6e 64 20 54 61 73 6b 73 22 0a 20 20 20 28 6c 65 nd Tasks". (le
c590: 74 2a 20 28 28 75 70 64 61 74 65 72 20 23 66 29 t* ((updater #f)
c5a0: 0a 09 20 20 28 6c 61 73 74 2d 78 61 64 6a 20 30 .. (last-xadj 0
c5b0: 29 0a 09 20 20 28 6c 61 73 74 2d 79 61 64 6a 20 ).. (last-yadj
c5c0: 30 29 0a 09 20 20 28 74 68 65 2d 63 6e 76 20 20 0).. (the-cnv
c5d0: 20 23 66 29 0a 09 20 20 28 63 61 6e 76 61 73 2d #f).. (canvas-
c5e0: 6f 62 6a 20 0a 09 20 20 20 28 69 75 70 3a 63 61 obj .. (iup:ca
c5f0: 6e 76 61 73 20 23 3a 61 63 74 69 6f 6e 20 28 6d nvas #:action (m
c600: 61 6b 65 2d 63 61 6e 76 61 73 2d 61 63 74 69 6f ake-canvas-actio
c610: 6e 0a 09 09 09 09 20 28 6c 61 6d 62 64 61 20 28 n..... (lambda (
c620: 63 6e 76 20 78 61 64 6a 20 79 61 64 6a 29 0a 09 cnv xadj yadj)..
c630: 09 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 75 ... (if (not u
c640: 70 64 61 74 65 72 29 0a 09 09 09 09 20 20 20 20 pdater).....
c650: 20 20 20 28 73 65 74 21 20 75 70 64 61 74 65 72 (set! updater
c660: 20 28 6c 61 6d 62 64 61 20 28 78 61 64 6a 20 79 (lambda (xadj y
c670: 61 64 6a 29 0a 09 09 09 09 09 09 20 20 20 20 20 adj).......
c680: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 63 6e 76 ;; (print "cnv
c690: 3a 20 22 20 63 6e 76 20 22 20 78 61 64 6a 3a 20 : " cnv " xadj:
c6a0: 22 20 78 61 64 6a 20 22 20 79 61 64 6a 3a 20 22 " xadj " yadj: "
c6b0: 20 79 61 64 6a 29 0a 09 09 09 09 09 09 20 20 20 yadj).......
c6c0: 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 64 (dashboard:d
c6d0: 72 61 77 2d 74 65 73 74 73 20 63 6e 76 20 78 61 raw-tests cnv xa
c6e0: 64 6a 20 79 61 64 6a 20 74 65 73 74 73 2d 64 72 dj yadj tests-dr
c6f0: 61 77 2d 73 74 61 74 65 20 73 6f 72 74 65 64 2d aw-state sorted-
c700: 74 65 73 74 6e 61 6d 65 73 20 74 65 73 74 2d 72 testnames test-r
c710: 65 63 6f 72 64 73 29 0a 09 09 09 09 09 09 20 20 ecords).......
c720: 20 20 20 20 20 28 73 65 74 21 20 6c 61 73 74 2d (set! last-
c730: 78 61 64 6a 20 78 61 64 6a 29 0a 09 09 09 09 09 xadj xadj)......
c740: 09 20 20 20 20 20 20 20 28 73 65 74 21 20 6c 61 . (set! la
c750: 73 74 2d 79 61 64 6a 20 79 61 64 6a 29 29 29 29 st-yadj yadj))))
c760: 0a 09 09 09 09 20 20 20 28 75 70 64 61 74 65 72 ..... (updater
c770: 20 78 61 64 6a 20 79 61 64 6a 29 0a 09 09 09 09 xadj yadj).....
c780: 20 20 20 28 73 65 74 21 20 74 68 65 2d 63 6e 76 (set! the-cnv
c790: 20 63 6e 76 29 0a 09 09 09 09 20 20 20 29 29 0a cnv)..... )).
c7a0: 09 09 20 20 20 20 20 20 20 3b 3b 20 46 6f 6c 6c .. ;; Foll
c7b0: 6f 77 69 6e 67 20 64 6f 65 73 6e 27 74 20 77 6f owing doesn't wo
c7c0: 72 6b 20 0a 09 09 20 20 20 20 20 20 20 23 3a 77 rk ... #:w
c7d0: 68 65 65 6c 2d 63 62 20 28 6c 61 6d 62 64 61 20 heel-cb (lambda
c7e0: 28 6f 62 6a 20 73 74 65 70 20 78 20 79 20 64 69 (obj step x y di
c7f0: 72 29 20 3b 3b 20 64 69 72 20 69 73 20 34 20 66 r) ;; dir is 4 f
c800: 6f 72 20 75 70 20 61 6e 64 20 35 20 66 6f 72 20 or up and 5 for
c810: 64 6f 77 6e 2e 20 49 20 74 68 69 6e 6b 2e 0a 09 down. I think...
c820: 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 73 63 ... (let ((sc
c830: 61 6c 65 66 20 28 68 61 73 68 2d 74 61 62 6c 65 alef (hash-table
c840: 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d -ref tests-draw-
c850: 73 74 61 74 65 20 27 73 63 61 6c 65 66 29 29 29 state 'scalef)))
c860: 0a 09 09 09 09 20 20 20 20 20 20 28 68 61 73 68 ..... (hash
c870: 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 -table-set! test
c880: 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73 63 s-draw-state 'sc
c890: 61 6c 65 66 20 28 2b 20 73 63 61 6c 65 66 0a 09 alef (+ scalef..
c8a0: 09 09 09 09 09 09 09 09 09 20 20 20 28 69 66 20 ......... (if
c8b0: 28 3e 20 73 74 65 70 20 30 29 0a 09 09 09 09 09 (> step 0)......
c8c0: 09 09 09 09 09 20 20 20 20 20 20 20 28 2a 20 73 ..... (* s
c8d0: 63 61 6c 65 66 20 30 2e 30 31 29 0a 09 09 09 09 calef 0.01).....
c8e0: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 2a 20 ...... (*
c8f0: 73 63 61 6c 65 66 20 2d 30 2e 30 31 29 29 29 29 scalef -0.01))))
c900: 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 20 74 ..... (if t
c910: 68 65 2d 63 6e 76 0a 09 09 09 09 09 20 20 28 64 he-cnv...... (d
c920: 61 73 68 62 6f 61 72 64 3a 64 72 61 77 2d 74 65 ashboard:draw-te
c930: 73 74 73 20 74 68 65 2d 63 6e 76 20 6c 61 73 74 sts the-cnv last
c940: 2d 78 61 64 6a 20 6c 61 73 74 2d 79 61 64 6a 20 -xadj last-yadj
c950: 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 tests-draw-state
c960: 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 sorted-testname
c970: 73 20 74 65 73 74 2d 72 65 63 6f 72 64 73 29 29 s test-records))
c980: 0a 09 09 09 09 20 20 20 20 20 20 29 29 0a 09 09 ..... ))...
c990: 20 20 20 20 20 20 20 3b 3b 20 23 3a 73 69 7a 65 ;; #:size
c9a0: 20 22 32 35 30 78 32 35 30 22 0a 09 09 20 20 20 "250x250"...
c9b0: 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 #:expand "YE
c9c0: 53 22 0a 09 09 20 20 20 20 20 20 20 23 3a 73 63 S"... #:sc
c9d0: 72 6f 6c 6c 62 61 72 20 22 59 45 53 22 0a 09 09 rollbar "YES"...
c9e0: 20 20 20 20 20 20 20 23 3a 70 6f 73 78 20 22 30 #:posx "0
c9f0: 2e 35 22 0a 09 09 20 20 20 20 20 20 20 23 3a 70 .5"... #:p
ca00: 6f 73 79 20 22 30 2e 35 22 0a 09 09 20 20 20 20 osy "0.5"...
ca10: 20 20 20 23 3a 62 75 74 74 6f 6e 2d 63 62 20 28 #:button-cb (
ca20: 6c 61 6d 62 64 61 20 28 6f 62 6a 20 62 74 6e 20 lambda (obj btn
ca30: 70 72 65 73 73 65 64 20 78 20 79 20 73 74 61 74 pressed x y stat
ca40: 75 73 29 0a 09 09 09 09 20 20 20 20 20 3b 3b 20 us)..... ;;
ca50: 28 70 72 69 6e 74 20 22 6f 62 6a 3a 20 22 20 6f (print "obj: " o
ca60: 62 6a 20 22 2c 20 70 72 65 73 73 65 64 20 22 20 bj ", pressed "
ca70: 70 72 65 73 73 65 64 20 22 2c 20 73 74 61 74 75 pressed ", statu
ca80: 73 20 22 20 73 74 61 74 75 73 29 0a 09 09 09 09 s " status).....
ca90: 09 3b 20 28 70 72 69 6e 74 20 22 63 61 6e 76 61 .; (print "canva
caa0: 73 2d 6f 72 69 67 69 6e 3a 20 22 20 28 63 61 6e s-origin: " (can
cab0: 76 61 73 2d 6f 72 69 67 69 6e 20 74 68 65 2d 63 vas-origin the-c
cac0: 6e 76 29 29 0a 09 09 09 09 20 20 20 20 20 3b 3b nv))..... ;;
cad0: 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 (let-values (((
cae0: 78 78 20 79 79 29 28 63 61 6e 76 61 73 2d 6f 72 xx yy)(canvas-or
caf0: 69 67 69 6e 20 74 68 65 2d 63 6e 76 29 29 29 0a igin the-cnv))).
cb00: 09 09 09 09 20 20 20 20 20 3b 3b 20 28 63 61 6e .... ;; (can
cb10: 76 61 73 2d 74 72 61 6e 73 66 6f 72 6d 2d 73 65 vas-transform-se
cb20: 74 21 20 74 68 65 2d 63 6e 76 20 23 66 29 0a 09 t! the-cnv #f)..
cb30: 09 09 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e ... ;; (prin
cb40: 74 20 22 63 61 6e 76 61 73 2d 6f 72 69 67 69 6e t "canvas-origin
cb50: 3a 20 22 20 78 78 20 22 20 22 20 79 79 20 22 20 : " xx " " yy "
cb60: 63 6c 69 63 6b 20 61 74 20 22 20 78 20 22 20 22 click at " x " "
cb70: 20 79 29 29 0a 09 09 09 09 20 20 20 20 20 28 6c y))..... (l
cb80: 65 74 2a 20 28 28 74 65 73 74 73 2d 69 6e 66 6f et* ((tests-info
cb90: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
cba0: 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d -ref tests-draw-
cbb0: 73 74 61 74 65 20 27 74 65 73 74 73 2d 69 6e 66 state 'tests-inf
cbc0: 6f 29 29 0a 09 09 09 09 09 20 20 20 20 28 73 65 o))...... (se
cbd0: 6c 65 63 74 65 64 2d 74 65 73 74 73 20 28 68 61 lected-tests (ha
cbe0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 sh-table-ref tes
cbf0: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73 ts-draw-state 's
cc00: 65 6c 65 63 74 65 64 2d 74 65 73 74 73 29 29 0a elected-tests)).
cc10: 09 09 09 09 09 20 20 20 20 28 73 63 61 6c 65 66 ..... (scalef
cc20: 20 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 (hash-t
cc30: 61 62 6c 65 2d 72 65 66 20 74 65 73 74 73 2d 64 able-ref tests-d
cc40: 72 61 77 2d 73 74 61 74 65 20 27 73 63 61 6c 65 raw-state 'scale
cc50: 66 29 29 0a 09 09 09 09 09 20 20 20 20 28 73 69 f))...... (si
cc60: 7a 65 79 20 20 20 20 20 20 20 20 20 20 28 68 61 zey (ha
cc70: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 sh-table-ref tes
cc80: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73 ts-draw-state 's
cc90: 69 7a 65 79 29 29 0a 09 09 09 09 09 20 20 20 20 izey))......
cca0: 28 78 6f 66 66 73 65 74 20 20 20 20 20 20 20 20 (xoffset
ccb0: 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 78 6f 66 (dcommon:get-xof
ccc0: 66 73 65 74 20 74 65 73 74 73 2d 64 72 61 77 2d fset tests-draw-
ccd0: 73 74 61 74 65 20 23 66 20 23 66 29 29 0a 09 09 state #f #f))...
cce0: 09 09 09 20 20 20 20 28 79 6f 66 66 73 65 74 20 ... (yoffset
ccf0: 20 20 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a (dcommon:
cd00: 67 65 74 2d 79 6f 66 66 73 65 74 20 74 65 73 74 get-yoffset test
cd10: 73 2d 64 72 61 77 2d 73 74 61 74 65 20 23 66 20 s-draw-state #f
cd20: 23 66 29 29 0a 09 09 09 09 09 20 20 20 20 28 6e #f))...... (n
cd30: 65 77 2d 79 20 20 20 20 20 20 20 20 20 20 28 2d ew-y (-
cd40: 20 73 69 7a 65 79 20 79 29 29 0a 09 09 09 09 09 sizey y))......
cd50: 20 20 20 20 28 74 65 73 74 2d 70 61 74 74 65 72 (test-patter
cd60: 6e 73 2d 74 65 78 74 62 6f 78 20 28 64 62 6f 61 ns-textbox (dboa
cd70: 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d 70 rd:tabdat-test-p
cd80: 61 74 74 65 72 6e 73 2d 74 65 78 74 62 6f 78 20 atterns-textbox
cd90: 74 61 62 64 61 74 29 29 29 0a 09 09 09 09 20 20 tabdat))).....
cda0: 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 ;; (print "
cdb0: 78 6f 66 66 73 65 74 3d 22 20 78 6f 66 66 73 65 xoffset=" xoffse
cdc0: 74 20 22 2c 20 79 6f 66 66 73 65 74 3d 22 20 79 t ", yoffset=" y
cdd0: 6f 66 66 73 65 74 29 0a 09 09 09 09 20 20 20 20 offset).....
cde0: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 5c 74 ;; (print "\t
cdf0: 78 5c 74 79 5c 74 6c 6c 78 5c 74 6c 6c 79 5c 74 x\ty\tllx\tlly\t
ce00: 75 72 78 5c 74 75 72 79 22 29 0a 09 09 09 09 20 urx\tury").....
ce10: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
ce20: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 6e 61 (lambda (test-na
ce30: 6d 65 29 0a 09 09 09 09 09 09 20 20 20 28 6c 65 me)....... (le
ce40: 74 2a 20 28 28 72 65 63 2d 63 6f 6f 72 64 73 20 t* ((rec-coords
ce50: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
ce60: 74 65 73 74 73 2d 69 6e 66 6f 20 74 65 73 74 2d tests-info test-
ce70: 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 09 20 20 name))........
ce80: 28 6c 6c 78 20 20 20 20 20 20 20 20 28 64 63 6f (llx (dco
ce90: 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 73 20 28 mmon:x->canvas (
cea0: 6c 69 73 74 2d 72 65 66 20 72 65 63 2d 63 6f 6f list-ref rec-coo
ceb0: 72 64 73 20 30 29 20 73 63 61 6c 65 66 20 78 6f rds 0) scalef xo
cec0: 66 66 73 65 74 29 29 0a 09 09 09 09 09 09 09 20 ffset))........
ced0: 20 28 6c 6c 79 20 20 20 20 20 20 20 20 28 64 63 (lly (dc
cee0: 6f 6d 6d 6f 6e 3a 79 2d 3e 63 61 6e 76 61 73 20 ommon:y->canvas
cef0: 28 6c 69 73 74 2d 72 65 66 20 72 65 63 2d 63 6f (list-ref rec-co
cf00: 6f 72 64 73 20 31 29 20 73 63 61 6c 65 66 20 79 ords 1) scalef y
cf10: 6f 66 66 73 65 74 29 29 0a 09 09 09 09 09 09 09 offset))........
cf20: 20 20 28 75 72 78 20 20 20 20 20 20 20 20 28 64 (urx (d
cf30: 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 73 common:x->canvas
cf40: 20 28 6c 69 73 74 2d 72 65 66 20 72 65 63 2d 63 (list-ref rec-c
cf50: 6f 6f 72 64 73 20 32 29 20 73 63 61 6c 65 66 20 oords 2) scalef
cf60: 78 6f 66 66 73 65 74 29 29 0a 09 09 09 09 09 09 xoffset)).......
cf70: 09 20 20 28 75 72 79 20 20 20 20 20 20 20 20 28 . (ury (
cf80: 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e 63 61 6e 76 61 dcommon:y->canva
cf90: 73 20 28 6c 69 73 74 2d 72 65 66 20 72 65 63 2d s (list-ref rec-
cfa0: 63 6f 6f 72 64 73 20 33 29 20 73 63 61 6c 65 66 coords 3) scalef
cfb0: 20 79 6f 66 66 73 65 74 29 29 29 0a 09 09 09 09 yoffset))).....
cfc0: 09 09 20 20 20 20 20 3b 3b 20 28 69 66 20 28 65 .. ;; (if (e
cfd0: 71 3f 20 70 72 65 73 73 65 64 20 31 29 0a 09 09 q? pressed 1)...
cfe0: 09 09 09 09 20 20 20 20 20 3b 3b 20 20 20 20 28 .... ;; (
cff0: 70 72 69 6e 74 20 22 5c 74 78 3d 22 20 78 20 22 print "\tx=" x "
d000: 5c 74 79 3d 22 20 79 20 22 5c 74 6e 65 77 2d 79 \ty=" y "\tnew-y
d010: 3d 22 20 6e 65 77 2d 79 20 22 5c 74 6c 6c 78 3d =" new-y "\tllx=
d020: 22 20 6c 6c 78 20 22 5c 74 6c 6c 79 3d 22 20 6c " llx "\tlly=" l
d030: 6c 79 20 22 5c 74 75 72 78 3d 22 20 75 72 78 20 ly "\turx=" urx
d040: 22 5c 74 75 72 79 3d 22 20 75 72 79 20 22 5c 74 "\tury=" ury "\t
d050: 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 22 29 " test-name " ")
d060: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 69 66 )....... (if
d070: 20 28 61 6e 64 20 28 65 71 3f 20 70 72 65 73 73 (and (eq? press
d080: 65 64 20 31 29 0a 09 09 09 09 09 09 09 20 20 20 ed 1)........
d090: 20 20 20 28 3e 3d 20 78 20 6c 6c 78 29 0a 09 09 (>= x llx)...
d0a0: 09 09 09 09 09 20 20 20 20 20 20 28 3e 3d 20 6e ..... (>= n
d0b0: 65 77 2d 79 20 6c 6c 79 29 0a 09 09 09 09 09 09 ew-y lly).......
d0c0: 09 20 20 20 20 20 20 28 3c 3d 20 78 20 75 72 78 . (<= x urx
d0d0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 28 )........ (
d0e0: 3c 3d 20 6e 65 77 2d 79 20 75 72 79 29 29 0a 09 <= new-y ury))..
d0f0: 09 09 09 09 09 09 20 28 6c 65 74 2a 20 28 28 62 ...... (let* ((b
d100: 6f 78 2d 70 61 74 74 65 72 6e 73 20 28 73 74 72 ox-patterns (str
d110: 69 6e 67 2d 73 70 6c 69 74 20 28 69 75 70 3a 61 ing-split (iup:a
d120: 74 74 72 69 62 75 74 65 20 74 65 73 74 2d 70 61 ttribute test-pa
d130: 74 74 65 72 6e 73 2d 74 65 78 74 62 6f 78 20 22 tterns-textbox "
d140: 56 41 4c 55 45 22 29 29 29 0a 20 20 20 20 20 20 VALUE"))).
d150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d180: 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74 2d (test-
d190: 70 61 74 74 73 20 20 20 28 73 74 72 69 6e 67 2d patts (string-
d1a0: 73 70 6c 69 74 20 28 6f 72 20 28 64 62 6f 61 72 split (or (dboar
d1b0: 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d 70 61 d:tabdat-test-pa
d1c0: 74 74 73 20 74 61 62 64 61 74 29 0a 20 20 20 20 tts tabdat).
d1d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d1e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d1f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d220: 20 20 20 20 20 20 20 20 20 20 20 20 22 22 29 0a "").
d230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d280: 20 20 20 20 20 20 20 20 20 20 20 20 22 2c 22 29 ",")
d290: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
d2a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d2b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d2c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d2d0: 20 20 28 70 61 74 74 65 72 6e 73 20 20 20 20 20 (patterns
d2e0: 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 (delete-duplicat
d2f0: 65 73 20 28 61 70 70 65 6e 64 20 62 6f 78 2d 70 es (append box-p
d300: 61 74 74 65 72 6e 73 20 74 65 73 74 2d 70 61 74 atterns test-pat
d310: 74 73 29 29 29 29 20 0a 09 09 09 09 09 09 09 20 ts)))) ........
d320: 20 20 28 6c 65 74 2a 20 28 28 73 65 6c 65 63 74 (let* ((select
d330: 65 64 20 20 20 20 20 28 6e 6f 74 20 28 6d 65 6d ed (not (mem
d340: 62 65 72 20 74 65 73 74 2d 6e 61 6d 65 20 70 61 ber test-name pa
d350: 74 74 65 72 6e 73 29 29 29 0a 09 09 09 09 09 09 tterns))).......
d360: 09 09 20 20 28 6e 65 77 70 61 74 74 2d 6c 69 73 .. (newpatt-lis
d370: 74 20 28 69 66 20 73 65 6c 65 63 74 65 64 0a 09 t (if selected..
d380: 09 09 09 09 09 09 09 09 09 20 20 20 20 28 63 6f ......... (co
d390: 6e 73 20 74 65 73 74 2d 6e 61 6d 65 20 70 61 74 ns test-name pat
d3a0: 74 65 72 6e 73 29 0a 09 09 09 09 09 09 09 09 09 terns)..........
d3b0: 09 20 20 20 20 28 64 65 6c 65 74 65 20 74 65 73 . (delete tes
d3c0: 74 2d 6e 61 6d 65 20 70 61 74 74 65 72 6e 73 29 t-name patterns)
d3d0: 29 29 0a 09 09 09 09 09 09 09 09 20 20 28 6e 65 ))......... (ne
d3e0: 77 70 61 74 74 20 20 20 20 20 20 28 73 74 72 69 wpatt (stri
d3f0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6e ng-intersperse n
d400: 65 77 70 61 74 74 2d 6c 69 73 74 20 22 5c 6e 22 ewpatt-list "\n"
d410: 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 )))........
d420: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
d430: 65 74 21 20 74 65 73 74 2d 70 61 74 74 65 72 6e et! test-pattern
d440: 73 2d 74 65 78 74 62 6f 78 20 22 56 41 4c 55 45 s-textbox "VALUE
d450: 22 20 6e 65 77 70 61 74 74 29 0a 09 09 09 09 09 " newpatt)......
d460: 09 09 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 .. (iup:attr
d470: 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 ibute-set! obj "
d480: 52 45 44 52 41 57 22 20 22 41 4c 4c 22 29 0a 09 REDRAW" "ALL")..
d490: 09 09 09 09 09 09 20 20 20 20 20 28 68 61 73 68 ...... (hash
d4a0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 6c 65 -table-set! sele
d4b0: 63 74 65 64 2d 74 65 73 74 73 20 74 65 73 74 2d cted-tests test-
d4c0: 6e 61 6d 65 20 73 65 6c 65 63 74 65 64 29 0a 09 name selected)..
d4d0: 09 09 09 09 09 09 20 20 20 20 20 28 64 62 6f 61 ...... (dboa
d4e0: 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d 70 rd:tabdat-test-p
d4f0: 61 74 74 73 2d 73 65 74 21 2d 75 73 65 20 74 61 atts-set!-use ta
d500: 62 64 61 74 20 28 64 62 6f 61 72 64 3a 6c 69 6e bdat (dboard:lin
d510: 65 73 2d 3e 74 65 73 74 2d 70 61 74 74 20 6e 65 es->test-patt ne
d520: 77 70 61 74 74 29 29 0a 09 09 09 09 09 09 09 20 wpatt))........
d530: 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 75 (dashboard:u
d540: 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 6e pdate-run-comman
d550: 64 20 74 61 62 64 61 74 29 0a 09 09 09 09 09 09 d tabdat).......
d560: 09 20 20 20 20 20 28 69 66 20 75 70 64 61 74 65 . (if update
d570: 72 20 28 75 70 64 61 74 65 72 20 6c 61 73 74 2d r (updater last-
d580: 78 61 64 6a 20 6c 61 73 74 2d 79 61 64 6a 29 29 xadj last-yadj))
d590: 29 29 29 29 29 0a 09 09 09 09 09 09 20 28 68 61 )))))....... (ha
d5a0: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 74 65 sh-table-keys te
d5b0: 73 74 73 2d 69 6e 66 6f 29 29 29 29 29 29 29 0a sts-info))))))).
d5c0: 20 20 20 20 20 63 61 6e 76 61 73 2d 6f 62 6a 29 canvas-obj)
d5d0: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
d5e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d5f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
d620: 20 53 20 54 20 45 20 50 20 53 0a 3b 3b 3d 3d 3d S T E P S.;;===
d630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d670: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 ===..(define (dc
d680: 6f 6d 6d 6f 6e 3a 70 6f 70 75 6c 61 74 65 2d 73 ommon:populate-s
d690: 74 65 70 73 20 74 65 73 74 73 74 65 70 73 20 73 teps teststeps s
d6a0: 74 65 70 73 2d 6d 61 74 72 69 78 20 72 75 6e 2d teps-matrix run-
d6b0: 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 6c id test-id). (l
d6c0: 65 74 2a 20 28 28 6d 61 78 2d 72 6f 77 20 20 20 et* ((max-row
d6d0: 20 20 20 20 30 29 0a 09 20 28 6d 61 78 2d 63 6f 0).. (max-co
d6e0: 6c 20 20 20 20 20 20 20 39 29 0a 20 20 20 20 20 l 9).
d6f0: 20 20 20 20 28 77 68 69 74 65 20 20 20 20 20 20 (white
d700: 20 20 20 22 32 35 35 20 32 35 35 20 32 35 35 22 "255 255 255"
d710: 29 0a 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 ). .
d720: 20 20 20 20 20 28 74 65 73 74 69 6e 66 6f 20 20 (testinfo
d730: 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 (rmt:get-tes
d740: 74 69 6e 66 6f 2d 73 74 61 74 65 2d 73 74 61 74 tinfo-state-stat
d750: 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 us run-id test-i
d760: 64 29 29 0a 20 20 20 20 20 20 20 20 20 28 73 74 d)). (st
d770: 61 74 65 20 20 20 20 20 20 20 20 20 28 64 62 3a ate (db:
d780: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
d790: 65 73 74 69 6e 66 6f 29 29 0a 20 20 20 20 20 20 estinfo)).
d7a0: 20 20 20 28 73 74 61 74 75 73 20 20 20 20 20 20 (status
d7b0: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 (db:test-get-s
d7c0: 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29 29 tatus testinfo))
d7d0: 0a 20 20 20 20 20 20 20 20 20 28 74 65 73 74 2d . (test-
d7e0: 73 74 61 74 75 73 2d 63 6f 6c 6f 72 20 28 63 61 status-color (ca
d7f0: 72 20 28 67 75 74 69 6c 73 3a 67 65 74 2d 63 6f r (gutils:get-co
d800: 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 lor-for-state-st
d810: 61 74 75 73 20 73 74 61 74 65 20 73 74 61 74 75 atus state statu
d820: 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 s))). (r
d830: 75 6e 6e 69 6e 67 2d 63 6f 6c 6f 72 20 28 63 61 unning-color (ca
d840: 72 20 28 67 75 74 69 6c 73 3a 67 65 74 2d 63 6f r (gutils:get-co
d850: 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 lor-for-state-st
d860: 61 74 75 73 20 22 52 55 4e 4e 49 4e 47 22 20 22 atus "RUNNING" "
d870: 53 54 41 52 54 45 44 22 29 29 29 0a 20 20 20 20 STARTED"))).
d880: 20 20 20 20 20 28 66 61 69 6c 63 6f 6c 6f 72 20 (failcolor
d890: 20 20 20 20 28 63 61 72 20 28 67 75 74 69 6c 73 (car (gutils
d8a0: 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 :get-color-for-s
d8b0: 74 61 74 65 2d 73 74 61 74 75 73 20 22 43 4f 4d tate-status "COM
d8c0: 50 4c 45 54 45 44 22 20 22 46 41 49 4c 22 29 29 PLETED" "FAIL"))
d8d0: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c )). (if (null
d8e0: 3f 20 74 65 73 74 73 74 65 70 73 29 0a 09 28 62 ? teststeps)..(b
d8f0: 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 28 egin. (
d900: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
d910: 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 t! steps-matrix
d920: 22 43 4c 45 41 52 41 54 54 52 49 42 22 20 22 43 "CLEARATTRIB" "C
d930: 4f 4e 54 45 4e 54 53 22 29 0a 20 20 20 20 20 20 ONTENTS").
d940: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
d950: 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d 6d 61 te-set! steps-ma
d960: 74 72 69 78 20 22 43 4c 45 41 52 56 41 4c 55 45 trix "CLEARVALUE
d970: 22 20 22 43 4f 4e 54 45 4e 54 53 22 29 29 0a 09 " "CONTENTS"))..
d980: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 (let loop ((hed
d990: 20 20 20 28 63 61 72 20 74 65 73 74 73 74 65 70 (car teststep
d9a0: 73 29 29 0a 09 09 20 20 20 28 74 61 6c 20 20 20 s))... (tal
d9b0: 20 28 63 64 72 20 74 65 73 74 73 74 65 70 73 29 (cdr teststeps)
d9c0: 29 0a 09 09 20 20 20 28 72 6f 77 6e 75 6d 20 31 )... (rownum 1
d9d0: 29 0a 09 09 20 20 20 28 63 6f 6c 6e 75 6d 20 31 )... (colnum 1
d9e0: 29 29 0a 09 20 20 28 69 66 20 28 3e 20 72 6f 77 )).. (if (> row
d9f0: 6e 75 6d 20 6d 61 78 2d 72 6f 77 29 28 73 65 74 num max-row)(set
da00: 21 20 6d 61 78 2d 72 6f 77 20 72 6f 77 6e 75 6d ! max-row rownum
da10: 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 73 74 )).. (let* ((st
da20: 61 74 75 73 20 20 28 76 65 63 74 6f 72 2d 72 65 atus (vector-re
da30: 66 20 68 65 64 20 33 29 29 0a 20 20 20 20 20 20 f hed 3)).
da40: 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 20 (val
da50: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
da60: 68 65 64 20 28 2d 20 63 6f 6c 6e 75 6d 20 31 29 hed (- colnum 1)
da70: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
da80: 20 20 20 20 28 62 67 63 6f 6c 6f 72 20 28 63 6f (bgcolor (co
da90: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
daa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
dab0: 6d 65 6d 62 65 72 20 28 63 6f 6e 63 20 73 74 61 member (conc sta
dac0: 74 75 73 29 20 27 28 22 22 20 22 2d 22 20 22 23 tus) '("" "-" "#
dad0: 3c 75 6e 73 70 65 63 69 66 69 65 64 3e 22 29 29 <unspecified>"))
dae0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
daf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 75 6e run
db00: 6e 69 6e 67 2d 63 6f 6c 6f 72 29 0a 20 20 20 20 ning-color).
db10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db20: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 .
db30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db40: 20 20 20 28 28 6d 65 6d 62 65 72 20 28 63 6f 6e ((member (con
db50: 63 20 73 74 61 74 75 73 29 20 27 28 22 30 22 20 c status) '("0"
db60: 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 0)).
db70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db80: 77 68 69 74 65 29 0a 20 20 20 20 20 20 20 20 20 white).
db90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dba0: 20 20 28 65 6c 73 65 20 74 65 73 74 2d 73 74 61 (else test-sta
dbb0: 74 75 73 2d 63 6f 6c 6f 72 29 29 29 0a 20 20 20 tus-color))).
dbc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dbd0: 20 20 20 20 20 20 20 3b 20 28 65 6c 73 65 20 66 ; (else f
dbe0: 61 69 6c 63 6f 6c 6f 72 29 29 29 0a 09 09 20 28 ailcolor)))... (
dbf0: 6d 74 72 78 2d 72 63 20 28 63 6f 6e 63 20 72 6f mtrx-rc (conc ro
dc00: 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 wnum ":" colnum)
dc10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 3b )). ;
dc20: 3b 28 70 72 69 6e 74 20 22 42 42 3e 20 73 74 61 ;(print "BB> sta
dc30: 74 75 73 3d 3e 22 73 74 61 74 75 73 22 3c 20 62 tus=>"status"< b
dc40: 67 63 6f 6c 6f 72 3d 22 62 67 63 6f 6c 6f 72 29 gcolor="bgcolor)
dc50: 0a 09 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 .. (iup:attri
dc60: 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d bute-set! steps-
dc70: 6d 61 74 72 69 78 20 20 6d 74 72 78 2d 72 63 20 matrix mtrx-rc
dc80: 28 69 66 20 76 61 6c 20 28 63 6f 6e 63 20 76 61 (if val (conc va
dc90: 6c 29 20 22 22 29 29 0a 20 20 20 20 20 20 20 20 l) "")).
dca0: 20 20 20 20 28 69 66 20 28 3c 20 63 6f 6c 6e 75 (if (< colnu
dcb0: 6d 20 35 29 0a 20 20 20 20 20 20 20 20 20 20 20 m 5).
dcc0: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
dcd0: 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d 6d ute-set! steps-m
dce0: 61 74 72 69 78 20 20 28 63 6f 6e 63 20 22 42 47 atrix (conc "BG
dcf0: 43 4f 4c 4f 52 22 20 6d 74 72 78 2d 72 63 29 20 COLOR" mtrx-rc)
dd00: 62 67 63 6f 6c 6f 72 29 29 0a 09 20 20 20 20 28 bgcolor)).. (
dd10: 69 66 20 28 3c 20 63 6f 6c 6e 75 6d 20 6d 61 78 if (< colnum max
dd20: 2d 63 6f 6c 29 0a 09 09 28 6c 6f 6f 70 20 68 65 -col)...(loop he
dd30: 64 20 74 61 6c 20 72 6f 77 6e 75 6d 20 28 2b 20 d tal rownum (+
dd40: 63 6f 6c 6e 75 6d 20 31 29 29 0a 09 09 28 69 66 colnum 1))...(if
dd50: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c (not (null? tal
dd60: 29 29 0a 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 ))... (loop (
dd70: 63 61 72 20 74 61 6c 29 20 28 63 64 72 20 74 61 car tal) (cdr ta
dd80: 6c 29 20 28 2b 20 72 6f 77 6e 75 6d 20 31 29 20 l) (+ rownum 1)
dd90: 31 29 29 29 29 29 29 0a 20 20 20 20 28 69 66 20 1)))))). (if
dda0: 28 3e 20 6d 61 78 2d 72 6f 77 20 30 29 0a 09 28 (> max-row 0)..(
ddb0: 62 65 67 69 6e 0a 09 20 20 3b 3b 20 77 65 20 61 begin.. ;; we a
ddc0: 72 65 20 67 6f 69 6e 67 20 74 6f 20 73 70 65 63 re going to spec
ddd0: 75 6c 61 74 69 76 65 6c 79 20 63 6c 65 61 72 20 ulatively clear
dde0: 72 6f 77 73 20 75 6e 74 69 6c 20 77 65 20 66 69 rows until we fi
ddf0: 6e 64 20 61 20 72 6f 77 20 74 68 61 74 20 69 73 nd a row that is
de00: 20 61 6c 72 65 61 64 79 20 63 6c 65 61 72 65 64 already cleared
de10: 0a 09 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 .. (let loop ((
de20: 72 6f 77 6e 75 6d 20 20 28 2b 20 6d 61 78 2d 72 rownum (+ max-r
de30: 6f 77 20 31 29 29 0a 09 09 20 20 20 20 20 28 63 ow 1))... (c
de40: 6f 6c 6e 75 6d 20 20 30 29 0a 09 09 20 20 20 20 olnum 0)...
de50: 20 28 64 65 6c 65 74 65 64 20 23 66 29 29 0a 09 (deleted #f))..
de60: 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
de70: 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
de80: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 ult-log-port* "c
de90: 6c 65 61 6e 69 6e 67 20 22 20 72 6f 77 6e 75 6d leaning " rownum
dea0: 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 0a 09 20 20 ":" colnum)..
deb0: 20 20 28 6c 65 74 2a 20 28 28 6e 65 78 74 2d 72 (let* ((next-r
dec0: 6f 77 20 28 69 66 20 28 65 71 3f 20 63 6f 6c 6e ow (if (eq? coln
ded0: 75 6d 20 6d 61 78 2d 63 6f 6c 29 20 28 2b 20 72 um max-col) (+ r
dee0: 6f 77 6e 75 6d 20 31 29 20 72 6f 77 6e 75 6d 29 ownum 1) rownum)
def0: 29 0a 09 09 20 20 20 28 6e 65 78 74 2d 63 6f 6c )... (next-col
df00: 20 28 69 66 20 28 65 71 3f 20 63 6f 6c 6e 75 6d (if (eq? colnum
df10: 20 6d 61 78 2d 63 6f 6c 29 20 31 20 28 2b 20 63 max-col) 1 (+ c
df20: 6f 6c 6e 75 6d 20 31 29 29 29 0a 09 09 20 20 20 olnum 1)))...
df30: 28 6d 74 72 78 2d 72 63 20 20 28 63 6f 6e 63 20 (mtrx-rc (conc
df40: 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 rownum ":" colnu
df50: 6d 29 29 0a 09 09 20 20 20 28 63 75 72 72 2d 76 m))... (curr-v
df60: 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 al (iup:attribut
df70: 65 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 6d e steps-matrix m
df80: 74 72 78 2d 72 63 29 29 29 0a 09 20 20 20 20 20 trx-rc)))..
df90: 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ;; (debug:print
dfa0: 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
dfb0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 6c 65 61 -log-port* "clea
dfc0: 6e 69 6e 67 20 22 20 72 6f 77 6e 75 6d 20 22 3a ning " rownum ":
dfd0: 22 20 63 6f 6c 6e 75 6d 20 22 20 63 75 72 72 76 " colnum " currv
dfe0: 61 6c 3d 20 22 20 63 75 72 72 2d 76 61 6c 29 0a al= " curr-val).
dff0: 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 . (if (and
e000: 28 73 74 72 69 6e 67 3f 20 63 75 72 72 2d 76 61 (string? curr-va
e010: 6c 29 0a 09 09 20 20 20 20 20 20 20 28 6e 6f 74 l)... (not
e020: 20 28 65 71 75 61 6c 3f 20 63 75 72 72 2d 76 61 (equal? curr-va
e030: 6c 20 22 22 29 29 29 0a 09 09 20 20 28 62 65 67 l "")))... (beg
e040: 69 6e 0a 09 09 20 20 20 20 28 69 75 70 3a 61 74 in... (iup:at
e050: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 tribute-set! ste
e060: 70 73 2d 6d 61 74 72 69 78 20 6d 74 72 78 2d 72 ps-matrix mtrx-r
e070: 63 20 22 22 29 0a 09 09 20 20 20 20 28 6c 6f 6f c "")... (loo
e080: 70 20 6e 65 78 74 2d 72 6f 77 20 6e 65 78 74 2d p next-row next-
e090: 63 6f 6c 20 23 74 29 29 0a 09 09 20 20 28 69 66 col #t))... (if
e0a0: 20 28 65 71 3f 20 63 6f 6c 6e 75 6d 20 6d 61 78 (eq? colnum max
e0b0: 2d 63 6f 6c 29 20 3b 3b 20 6e 6f 74 20 64 6f 6e -col) ;; not don
e0c0: 65 2c 20 64 69 64 6e 27 74 20 67 65 74 20 61 20 e, didn't get a
e0d0: 66 75 6c 6c 20 62 6c 61 6e 6b 20 72 6f 77 0a 09 full blank row..
e0e0: 09 20 20 20 20 20 20 28 69 66 20 64 65 6c 65 74 . (if delet
e0f0: 65 64 20 28 6c 6f 6f 70 20 6e 65 78 74 2d 72 6f ed (loop next-ro
e100: 77 20 6e 65 78 74 2d 63 6f 6c 20 23 66 29 29 20 w next-col #f))
e110: 3b 3b 20 65 78 69 74 20 6f 6e 20 74 68 69 73 20 ;; exit on this
e120: 6e 6f 74 20 6d 65 74 0a 09 09 20 20 20 20 20 20 not met...
e130: 28 6c 6f 6f 70 20 6e 65 78 74 2d 72 6f 77 20 6e (loop next-row n
e140: 65 78 74 2d 63 6f 6c 20 64 65 6c 65 74 65 64 29 ext-col deleted)
e150: 29 29 29 29 0a 09 20 20 28 69 75 70 3a 61 74 74 )))).. (iup:att
e160: 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 ribute-set! step
e170: 73 2d 6d 61 74 72 69 78 20 22 52 45 44 52 41 57 s-matrix "REDRAW
e180: 22 20 22 41 4c 4c 22 29 29 29 29 29 0a 0a 3b 3b " "ALL")))))..;;
e190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e1a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e1b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e1c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e1d0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 20 54 20 49 20 ======.;; U T I
e1e0: 4c 20 49 20 54 20 49 20 45 20 53 0a 3b 3b 3d 3d L I T I E S.;;==
e1f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e230: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 ====..(define (d
e240: 63 6f 6d 6d 6f 6e 3a 72 75 6e 2d 68 74 6d 6c 2d common:run-html-
e250: 76 69 65 77 65 72 20 6c 66 69 6c 65 6e 61 6d 65 viewer lfilename
e260: 29 0a 20 20 28 6c 65 74 20 28 28 68 74 6d 6c 76 ). (let ((htmlv
e270: 69 65 77 65 72 63 6d 64 20 28 63 6f 6e 66 69 67 iewercmd (config
e280: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
e290: 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 68 74 dat* "setup" "ht
e2a0: 6d 6c 76 69 65 77 65 72 63 6d 64 22 29 29 29 0a mlviewercmd"))).
e2b0: 20 20 20 20 28 69 66 20 68 74 6d 6c 76 69 65 77 (if htmlview
e2c0: 65 72 63 6d 64 0a 09 28 73 79 73 74 65 6d 20 28 ercmd..(system (
e2d0: 63 6f 6e 63 20 22 28 22 20 68 74 6d 6c 76 69 65 conc "(" htmlvie
e2e0: 77 65 72 63 6d 64 20 22 20 22 20 6c 66 69 6c 65 wercmd " " lfile
e2f0: 6e 61 6d 65 20 22 20 29 20 26 22 29 29 20 0a 09 name " ) &")) ..
e300: 28 69 75 70 3a 73 65 6e 64 2d 75 72 6c 20 6c 66 (iup:send-url lf
e310: 69 6c 65 6e 61 6d 65 29 29 29 29 0a 0a ilename))))..