Megatest

Artifact 83db082a27ced8753f802e5e5a4557ef398fb755:

• File dcommon-inc.scm — part of check-in [fde3cd0ad1] at 2019-11-03 04:00:00 on branch v1.65-try3 — try3 (user: matt, size: 58094) [annotate] [blame] [check-ins using]
• File dcommon.scm — part of check-in [1b5d412efb] at 2019-06-12 10:41:51 on branch v1.65-ezsteps-tcp — cleared steps matrix on rerun and clean-run-execute (user: bjbarcla, size: 58094) [annotate] [blame] [check-ins using]

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 3b 3b 20 28 64 65 63 6c 61 72 65 20 28  )).;; (declare (
0490: 75 73 65 73 20 73 79 6e 63 68 61 73 68 29 29 0a  uses synchash)).
04a0: 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f  .(include "commo
04b0: 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a  n_records.scm").
04c0: 28 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 63  (include "db_rec
04d0: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c  ords.scm").(incl
04e0: 75 64 65 20 22 6b 65 79 5f 72 65 63 6f 72 64 73  ude "key_records
04f0: 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20  .scm").(include 
0500: 22 72 75 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d  "run_records.scm
0510: 22 29 0a 0a 3b 3b 20 79 65 73 2c 20 74 68 69 73  ")..;; yes, this
0520: 20 69 73 20 6e 6f 6e 2d 69 64 65 61 6c 20 0a 28   is non-ideal .(
0530: 64 65 66 69 6e 65 20 64 61 73 68 62 6f 61 72 64  define dashboard
0540: 3a 75 70 64 61 74 65 2d 73 75 6d 6d 61 72 79 2d  :update-summary-
0550: 74 61 62 20 23 66 29 0a 28 64 65 66 69 6e 65 20  tab #f).(define 
0560: 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65  dashboard:update
0570: 2d 73 65 72 76 65 72 73 2d 74 61 62 6c 65 20 23  -servers-table #
0580: 66 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  f)..;;==========
0590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
05a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
05b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
05c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20  ============.;; 
05d0: 43 20 4f 20 4d 20 4d 20 4f 20 4e 20 20 20 44 20  C O M M O N   D 
05e0: 41 20 54 20 41 20 20 20 53 20 54 20 52 20 55 20  A T A   S T R U 
05f0: 43 20 54 20 55 20 52 20 45 0a 3b 3b 3d 3d 3d 3d  C T U R E.;;====
0600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0640: 3d 3d 0a 3b 3b 20 0a 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 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: 0a 3b 3b 20 44 20 4f 20 54 20 46 20 49 20 4c 20  .;; D O T F I L 
06a0: 45 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  E.;;============
06b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
06c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
06d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
06e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66  ==========..(def
06f0: 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 77 72 69  ine (dcommon:wri
0700: 74 65 2d 64 6f 74 66 69 6c 65 20 66 6e 61 6d 65  te-dotfile fname
0710: 20 64 61 74 29 0a 20 20 28 77 69 74 68 2d 6f 75   dat).  (with-ou
0720: 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 66 6e 61  tput-to-file fna
0730: 6d 65 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28  me.    (lambda (
0740: 29 0a 20 20 20 20 20 20 28 70 70 20 64 61 74 29  ).      (pp dat)
0750: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d  )))..;;=========
0760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b  =============.;;
07a0: 20 54 41 52 47 45 54 20 41 4e 44 20 50 41 54 54   TARGET AND PATT
07b0: 45 52 4e 20 4d 41 4e 49 50 55 4c 41 54 49 4f 4e  ERN MANIPULATION
07c0: 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  S.;;============
07d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
07e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
07f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 43  ==========..;; C
0810: 6f 6e 76 65 72 74 20 74 6f 20 61 6e 64 20 66 72  onvert to and fr
0820: 6f 6d 20 6c 69 73 74 20 6f 66 20 6c 69 6e 65 73  om list of lines
0830: 20 28 66 6f 72 20 61 20 74 65 78 74 20 62 6f 78   (for a text box
0840: 29 0a 3b 3b 20 22 2c 22 20 3d 3e 20 22 5c 6e 22  ).;; "," => "\n"
0850: 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64  .(define (dboard
0860: 3a 74 65 73 74 2d 70 61 74 74 2d 3e 6c 69 6e 65  :test-patt->line
0870: 73 20 74 65 73 74 2d 70 61 74 74 29 0a 20 20 28  s test-patt).  (
0880: 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74  string-substitut
0890: 65 20 28 72 65 67 65 78 70 20 22 2c 22 29 20 22  e (regexp ",") "
08a0: 5c 6e 22 20 74 65 73 74 2d 70 61 74 74 29 29 0a  \n" test-patt)).
08b0: 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64  .(define (dboard
08c0: 3a 6c 69 6e 65 73 2d 3e 74 65 73 74 2d 70 61 74  :lines->test-pat
08d0: 74 20 6c 69 6e 65 73 29 0a 20 20 28 73 74 72 69  t lines).  (stri
08e0: 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 28 72  ng-substitute (r
08f0: 65 67 65 78 70 20 22 5c 6e 22 29 20 22 2c 22 20  egexp "\n") "," 
0900: 6c 69 6e 65 73 20 23 74 29 29 0a 0a 0a 3b 3b 3d  lines #t))...;;=
0910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0950: 3d 3d 3d 3d 3d 0a 3b 3b 20 50 20 52 20 4f 20 43  =====.;; P R O C
0960: 20 45 20 53 20 53 20 20 20 52 20 55 20 4e 20 53   E S S   R U N S
0970: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  .;;=============
0980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
0990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
09a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
09b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4d 4f  =========..;; MO
09c0: 56 45 20 54 48 49 53 20 49 4e 54 4f 20 2a 64 61  VE THIS INTO *da
09d0: 74 61 2a 0a 28 64 65 66 69 6e 65 20 2a 63 61 63  ta*.(define *cac
09e0: 68 65 64 61 74 61 2a 20 28 6d 61 6b 65 2d 68 61  hedata* (make-ha
09f0: 73 68 2d 74 61 62 6c 65 29 29 0a 28 68 61 73 68  sh-table)).(hash
0a00: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 63 61 63  -table-set! *cac
0a10: 68 65 64 61 74 61 2a 20 22 72 75 6e 69 64 2d 74  hedata* "runid-t
0a20: 6f 2d 63 6f 6c 22 20 20 20 20 28 6d 61 6b 65 2d  o-col"    (make-
0a30: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 68 61  hash-table)).(ha
0a40: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 63  sh-table-set! *c
0a50: 61 63 68 65 64 61 74 61 2a 20 22 74 65 73 74 6e  achedata* "testn
0a60: 61 6d 65 2d 74 6f 2d 72 6f 77 22 20 28 6d 61 6b  ame-to-row" (mak
0a70: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 0a  e-hash-table))..
0a80: 3b 3b 20 6d 6f 64 69 66 79 20 61 20 63 65 6c 6c  ;; modify a cell
0a90: 20 69 66 20 74 68 65 20 64 61 74 61 20 69 73 20   if the data is 
0aa0: 63 68 61 6e 67 65 64 2c 20 72 65 74 75 72 6e 20  changed, return 
0ab0: 23 74 20 6f 72 2d 65 64 20 77 69 74 68 20 70 72  #t or-ed with pr
0ac0: 65 76 69 6f 75 73 20 69 66 20 6d 6f 64 69 66 69  evious if modifi
0ad0: 65 64 2c 20 23 66 20 65 6c 73 65 77 69 73 65 0a  ed, #f elsewise.
0ae0: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d  ;;.(define (dcom
0af0: 6d 6f 6e 3a 6d 6f 64 69 66 69 79 2d 69 66 2d 64  mon:modifiy-if-d
0b00: 69 66 66 65 72 65 6e 74 20 6d 74 72 78 20 63 65  ifferent mtrx ce
0b10: 6c 6c 2d 6e 61 6d 65 20 6e 65 77 2d 76 61 6c 20  ll-name new-val 
0b20: 70 72 65 76 2d 63 68 61 6e 67 65 64 29 0a 20 20  prev-changed).  
0b30: 28 6c 65 74 20 28 28 63 75 72 72 2d 76 61 6c 20  (let ((curr-val 
0b40: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 6d  (iup:attribute m
0b50: 74 72 78 20 63 65 6c 6c 2d 6e 61 6d 65 29 29 29  trx cell-name)))
0b60: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65  .    (if (not (e
0b70: 71 75 61 6c 3f 20 63 75 72 72 2d 76 61 6c 20 6e  qual? curr-val n
0b80: 65 77 2d 76 61 6c 29 29 20 0a 09 28 62 65 67 69  ew-val)) ..(begi
0b90: 6e 0a 09 20 20 28 69 75 70 3a 61 74 74 72 69 62  n..  (iup:attrib
0ba0: 75 74 65 2d 73 65 74 21 20 6d 74 72 78 20 63 65  ute-set! mtrx ce
0bb0: 6c 6c 2d 6e 61 6d 65 20 63 6f 6c 2d 6e 61 6d 65  ll-name col-name
0bc0: 29 0a 09 20 20 23 74 29 20 3b 3b 20 6e 65 65 64  )..  #t) ;; need
0bd0: 20 61 20 72 65 2d 64 72 61 77 0a 09 70 72 65 76   a re-draw..prev
0be0: 2d 63 68 61 6e 67 65 64 29 29 29 0a 0a 0a 3b 3b  -changed)))...;;
0bf0: 20 54 4f 2d 44 4f 0a 3b 3b 20 20 31 2e 20 4d 61   TO-DO.;;  1. Ma
0c00: 6b 65 20 22 64 61 74 61 22 20 68 61 73 68 2d 74  ke "data" hash-t
0c10: 61 62 6c 65 20 68 69 65 72 61 72 63 68 69 61 6c  able hierarchial
0c20: 20 73 74 6f 72 65 20 6f 66 20 61 6c 6c 20 64 69   store of all di
0c30: 73 70 6c 61 79 65 64 20 64 61 74 61 0a 3b 3b 20  splayed data.;; 
0c40: 20 32 2e 20 55 70 64 61 74 65 20 73 79 6e 63 68   2. Update synch
0c50: 61 73 68 20 74 6f 20 75 6e 64 65 72 73 74 61 6e  ash to understan
0c60: 64 20 22 67 65 74 2d 72 75 6e 73 22 2c 20 22 67  d "get-runs", "g
0c70: 65 74 2d 74 65 73 74 73 22 20 65 74 63 2e 0a 3b  et-tests" etc..;
0c80: 3b 20 20 33 2e 20 41 64 64 20 65 78 74 72 61 63  ;  3. Add extrac
0c90: 74 69 6f 6e 20 6f 66 20 66 69 6c 74 65 72 73 20  tion of filters 
0ca0: 74 6f 20 73 79 6e 63 68 61 73 68 20 63 61 6c 6c  to synchash call
0cb0: 73 0a 3b 3b 0a 3b 3b 20 20 20 20 4e 4f 54 45 3a  s.;;.;;    NOTE:
0cc0: 20 55 73 65 64 20 69 6e 20 6e 65 77 64 61 73 68   Used in newdash
0cd0: 62 6f 61 72 64 0a 3b 3b 0a 3b 3b 20 4d 6f 64 65  board.;;.;; Mode
0ce0: 20 69 73 20 27 66 75 6c 6c 20 6f 72 20 27 69 6e   is 'full or 'in
0cf0: 63 72 65 6d 65 6e 74 61 6c 20 66 6f 72 20 66 75  cremental for fu
0d00: 6c 6c 20 72 65 66 72 65 73 68 20 6f 72 20 69 6e  ll refresh or in
0d10: 63 72 65 6d 65 6e 74 61 6c 20 72 65 66 72 65 73  cremental refres
0d20: 68 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 64 63  h.;; (define (dc
0d30: 6f 6d 6d 6f 6e 3a 72 75 6e 2d 75 70 64 61 74 65  ommon:run-update
0d40: 20 6b 65 79 73 20 64 61 74 61 20 72 75 6e 6e 61   keys data runna
0d50: 6d 65 20 6b 65 79 70 61 74 74 73 20 74 65 73 74  me keypatts test
0d60: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74  patt states stat
0d70: 75 73 65 73 20 6d 6f 64 65 20 77 69 6e 64 6f 77  uses mode window
0d80: 2d 69 64 29 0a 3b 3b 20 20 20 28 6c 65 74 2a 20  -id).;;   (let* 
0d90: 28 3b 3b 20 63 6f 75 6e 74 20 61 6e 64 20 6f 66  (;; count and of
0da0: 66 73 65 74 20 3d 3e 20 23 66 20 73 6f 20 6e 6f  fset => #f so no
0db0: 74 20 75 73 65 64 0a 3b 3b 20 09 20 3b 3b 20 74  t used.;; . ;; t
0dc0: 68 65 20 73 79 6e 63 68 61 73 68 20 63 61 6c 6c  he synchash call
0dd0: 73 20 6d 6f 64 69 66 79 20 74 68 65 20 22 64 61  s modify the "da
0de0: 74 61 22 20 68 61 73 68 0a 3b 3b 20 09 20 28 63  ta" hash.;; . (c
0df0: 68 61 6e 67 65 64 20 20 20 20 20 20 20 20 20 23  hanged         #
0e00: 66 29 0a 3b 3b 20 09 20 28 67 65 74 2d 72 75 6e  f).;; . (get-run
0e10: 73 2d 73 69 67 20 20 20 20 28 63 6f 6e 63 20 28  s-sig    (conc (
0e20: 63 6c 69 65 6e 74 3a 67 65 74 2d 73 69 67 6e 61  client:get-signa
0e30: 74 75 72 65 29 20 22 20 67 65 74 2d 72 75 6e 73  ture) " get-runs
0e40: 22 29 29 0a 3b 3b 20 09 20 28 67 65 74 2d 74 65  ")).;; . (get-te
0e50: 73 74 73 2d 73 69 67 20 20 20 28 63 6f 6e 63 20  sts-sig   (conc 
0e60: 28 63 6c 69 65 6e 74 3a 67 65 74 2d 73 69 67 6e  (client:get-sign
0e70: 61 74 75 72 65 29 20 22 20 67 65 74 2d 74 65 73  ature) " get-tes
0e80: 74 73 22 29 29 0a 3b 3b 20 09 20 28 67 65 74 2d  ts")).;; . (get-
0e90: 64 65 74 61 69 6c 73 2d 73 69 67 20 28 63 6f 6e  details-sig (con
0ea0: 63 20 28 63 6c 69 65 6e 74 3a 67 65 74 2d 73 69  c (client:get-si
0eb0: 67 6e 61 74 75 72 65 29 20 22 20 67 65 74 2d 74  gnature) " get-t
0ec0: 65 73 74 2d 64 65 74 61 69 6c 73 22 29 29 0a 3b  est-details")).;
0ed0: 3b 20 0a 3b 3b 20 09 20 3b 3b 20 74 65 73 74 2d  ; .;; . ;; test-
0ee0: 69 64 73 20 74 6f 20 67 65 74 20 61 6e 64 20 64  ids to get and d
0ef0: 69 73 70 6c 61 79 20 61 72 65 20 69 6e 64 65 78  isplay are index
0f00: 65 64 20 6f 6e 20 77 69 6e 64 6f 77 2d 69 64 20  ed on window-id 
0f10: 69 6e 20 63 75 72 72 2d 74 65 73 74 2d 69 64 73  in curr-test-ids
0f20: 20 68 61 73 68 0a 3b 3b 20 09 20 28 74 65 73 74   hash.;; . (test
0f30: 2d 69 64 73 20 20 20 20 20 20 20 20 28 68 61 73  -ids        (has
0f40: 68 2d 74 61 62 6c 65 2d 76 61 6c 75 65 73 20 28  h-table-values (
0f50: 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 63 75  dboard:tabdat-cu
0f60: 72 72 2d 74 65 73 74 2d 69 64 73 20 64 61 74 61  rr-test-ids data
0f70: 29 29 29 0a 3b 3b 20 09 20 3b 3b 20 72 75 6e 2d  ))).;; . ;; run-
0f80: 69 64 20 69 73 20 23 66 20 69 6e 20 6e 65 78 74  id is #f in next
0f90: 20 6c 69 6e 65 20 74 6f 20 73 65 6e 64 20 74 68   line to send th
0fa0: 65 20 71 75 65 72 79 20 74 6f 20 73 65 72 76 65  e query to serve
0fb0: 72 20 30 0a 3b 3b 20 20 09 20 28 72 75 6e 2d 63  r 0.;;  . (run-c
0fc0: 68 61 6e 67 65 73 20 20 20 20 20 28 73 79 6e 63  hanges     (sync
0fd0: 68 61 73 68 3a 63 6c 69 65 6e 74 2d 67 65 74 20  hash:client-get 
0fe0: 27 64 62 3a 67 65 74 2d 72 75 6e 73 20 67 65 74  'db:get-runs get
0ff0: 2d 72 75 6e 73 2d 73 69 67 20 28 6c 65 6e 67 74  -runs-sig (lengt
1000: 68 20 6b 65 79 70 61 74 74 73 29 20 64 61 74 61  h keypatts) data
1010: 20 23 66 20 72 75 6e 6e 61 6d 65 20 23 66 20 23   #f runname #f #
1020: 66 20 6b 65 79 70 61 74 74 73 29 29 0a 3b 3b 20  f keypatts)).;; 
1030: 09 20 28 74 65 73 74 73 2d 64 65 74 61 69 6c 2d  . (tests-detail-
1040: 63 68 61 6e 67 65 73 20 28 69 66 20 28 6e 6f 74  changes (if (not
1050: 20 28 6e 75 6c 6c 3f 20 74 65 73 74 2d 69 64 73   (null? test-ids
1060: 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 28 73 79  )).;; ....   (sy
1070: 6e 63 68 61 73 68 3a 63 6c 69 65 6e 74 2d 67 65  nchash:client-ge
1080: 74 20 27 64 62 3a 67 65 74 2d 74 65 73 74 2d 69  t 'db:get-test-i
1090: 6e 66 6f 2d 62 79 2d 69 64 73 20 67 65 74 2d 64  nfo-by-ids get-d
10a0: 65 74 61 69 6c 73 2d 73 69 67 20 30 20 20 64 61  etails-sig 0  da
10b0: 74 61 20 23 66 20 74 65 73 74 2d 69 64 73 29 0a  ta #f test-ids).
10c0: 3b 3b 20 09 09 09 09 20 20 20 27 28 29 29 29 0a  ;; ....   '())).
10d0: 3b 3b 20 0a 3b 3b 20 09 20 3b 3b 20 4e 6f 77 20  ;; .;; . ;; Now 
10e0: 63 61 6e 20 63 61 6c 63 75 6c 61 74 65 20 74 68  can calculate th
10f0: 65 20 72 75 6e 2d 69 64 73 0a 3b 3b 20 09 20 28  e run-ids.;; . (
1100: 72 75 6e 2d 68 61 73 68 20 20 20 20 28 68 61 73  run-hash    (has
1110: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61  h-table-ref/defa
1120: 75 6c 74 20 64 61 74 61 20 67 65 74 2d 72 75 6e  ult data get-run
1130: 73 2d 73 69 67 20 23 66 29 29 0a 3b 3b 20 09 20  s-sig #f)).;; . 
1140: 28 72 75 6e 2d 69 64 73 20 20 20 20 20 28 69 66  (run-ids     (if
1150: 20 72 75 6e 2d 68 61 73 68 20 28 66 69 6c 74 65   run-hash (filte
1160: 72 20 6e 75 6d 62 65 72 3f 20 28 68 61 73 68 2d  r number? (hash-
1170: 74 61 62 6c 65 2d 6b 65 79 73 20 72 75 6e 2d 68  table-keys run-h
1180: 61 73 68 29 29 20 27 28 29 29 29 0a 3b 3b 20 0a  ash)) '())).;; .
1190: 3b 3b 20 09 20 28 61 6c 6c 2d 74 65 73 74 2d 63  ;; . (all-test-c
11a0: 68 61 6e 67 65 73 20 28 6c 65 74 20 28 28 72 65  hanges (let ((re
11b0: 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62  s (make-hash-tab
11c0: 6c 65 29 29 29 0a 3b 3b 20 09 09 09 20 20 20 20  le))).;; ...    
11d0: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62   (for-each (lamb
11e0: 64 61 20 28 72 75 6e 2d 69 64 29 0a 3b 3b 20 09  da (run-id).;; .
11f0: 09 09 09 09 20 28 69 66 20 28 3e 20 72 75 6e 2d  .... (if (> run-
1200: 69 64 20 30 29 0a 3b 3b 20 09 09 09 09 09 20 20  id 0).;; .....  
1210: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73     (hash-table-s
1220: 65 74 21 20 72 65 73 20 72 75 6e 2d 69 64 20 28  et! res run-id (
1230: 73 79 6e 63 68 61 73 68 3a 63 6c 69 65 6e 74 2d  synchash:client-
1240: 67 65 74 20 27 64 62 3a 67 65 74 2d 74 65 73 74  get 'db:get-test
1250: 73 2d 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74  s-for-run-mindat
1260: 61 20 67 65 74 2d 74 65 73 74 73 2d 73 69 67 20  a get-tests-sig 
1270: 30 20 64 61 74 61 20 72 75 6e 2d 69 64 20 31 20  0 data run-id 1 
1280: 74 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20  testpatt states 
1290: 73 74 61 74 75 73 65 73 20 23 66 29 29 29 29 0a  statuses #f)))).
12a0: 3b 3b 20 09 09 09 09 20 20 20 20 20 20 20 72 75  ;; ....       ru
12b0: 6e 2d 69 64 73 29 0a 3b 3b 20 09 09 09 20 20 20  n-ids).;; ...   
12c0: 20 20 72 65 73 29 29 0a 3b 3b 20 09 20 28 72 75    res)).;; . (ru
12d0: 6e 73 2d 68 61 73 68 20 20 20 20 28 68 61 73 68  ns-hash    (hash
12e0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75  -table-ref/defau
12f0: 6c 74 20 64 61 74 61 20 67 65 74 2d 72 75 6e 73  lt data get-runs
1300: 2d 73 69 67 20 23 66 29 29 0a 3b 3b 20 09 20 28  -sig #f)).;; . (
1310: 68 65 61 64 65 72 20 20 20 20 20 20 20 28 68 61  header       (ha
1320: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66  sh-table-ref/def
1330: 61 75 6c 74 20 72 75 6e 73 2d 68 61 73 68 20 22  ault runs-hash "
1340: 68 65 61 64 65 72 22 20 23 66 29 29 0a 3b 3b 20  header" #f)).;; 
1350: 09 20 28 72 75 6e 2d 69 64 73 20 20 20 20 20 20  . (run-ids      
1360: 28 73 6f 72 74 20 28 66 69 6c 74 65 72 20 6e 75  (sort (filter nu
1370: 6d 62 65 72 3f 20 28 68 61 73 68 2d 74 61 62 6c  mber? (hash-tabl
1380: 65 2d 6b 65 79 73 20 72 75 6e 73 2d 68 61 73 68  e-keys runs-hash
1390: 29 29 0a 3b 3b 20 09 09 09 20 20 20 20 20 28 6c  )).;; ...     (l
13a0: 61 6d 62 64 61 20 28 61 20 62 29 0a 3b 3b 20 09  ambda (a b).;; .
13b0: 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28  ..       (let* (
13c0: 28 72 65 63 6f 72 64 2d 61 20 28 68 61 73 68 2d  (record-a (hash-
13d0: 74 61 62 6c 65 2d 72 65 66 20 72 75 6e 73 2d 68  table-ref runs-h
13e0: 61 73 68 20 61 29 29 0a 3b 3b 20 09 09 09 09 20  ash a)).;; .... 
13f0: 20 20 20 20 20 28 72 65 63 6f 72 64 2d 62 20 28       (record-b (
1400: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 72  hash-table-ref r
1410: 75 6e 73 2d 68 61 73 68 20 62 29 29 0a 3b 3b 20  uns-hash b)).;; 
1420: 09 09 09 09 20 20 20 20 20 20 28 74 69 6d 65 2d  ....      (time-
1430: 61 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75  a   (db:get-valu
1440: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 65 63 6f  e-by-header reco
1450: 72 64 2d 61 20 68 65 61 64 65 72 20 22 65 76 65  rd-a header "eve
1460: 6e 74 5f 74 69 6d 65 22 29 29 0a 3b 3b 20 09 09  nt_time")).;; ..
1470: 09 09 20 20 20 20 20 20 28 74 69 6d 65 2d 62 20  ..      (time-b 
1480: 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d    (db:get-value-
1490: 62 79 2d 68 65 61 64 65 72 20 72 65 63 6f 72 64  by-header record
14a0: 2d 62 20 68 65 61 64 65 72 20 22 65 76 65 6e 74  -b header "event
14b0: 5f 74 69 6d 65 22 29 29 29 0a 3b 3b 20 09 09 09  _time"))).;; ...
14c0: 09 20 28 3e 20 74 69 6d 65 2d 61 20 74 69 6d 65  . (> time-a time
14d0: 2d 62 29 29 29 0a 3b 3b 20 09 09 09 20 20 20 20  -b))).;; ...    
14e0: 20 29 29 0a 3b 3b 20 09 20 28 72 75 6e 69 64 2d   )).;; . (runid-
14f0: 74 6f 2d 63 6f 6c 20 20 20 20 28 68 61 73 68 2d  to-col    (hash-
1500: 74 61 62 6c 65 2d 72 65 66 20 2a 63 61 63 68 65  table-ref *cache
1510: 64 61 74 61 2a 20 22 72 75 6e 69 64 2d 74 6f 2d  data* "runid-to-
1520: 63 6f 6c 22 29 29 0a 3b 3b 20 09 20 28 74 65 73  col")).;; . (tes
1530: 74 6e 61 6d 65 2d 74 6f 2d 72 6f 77 20 28 68 61  tname-to-row (ha
1540: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 2a 63 61  sh-table-ref *ca
1550: 63 68 65 64 61 74 61 2a 20 22 74 65 73 74 6e 61  chedata* "testna
1560: 6d 65 2d 74 6f 2d 72 6f 77 22 29 29 20 0a 3b 3b  me-to-row")) .;;
1570: 20 09 20 28 63 6f 6c 6e 75 6d 20 20 20 20 20 20   . (colnum      
1580: 20 31 29 0a 3b 3b 20 09 20 28 72 6f 77 6e 75 6d   1).;; . (rownum
1590: 20 20 20 20 20 20 20 30 29 0a 3b 3b 20 09 20 28         0).;; . (
15a0: 63 65 6c 6c 6e 61 6d 65 20 28 63 6f 6e 63 20 72  cellname (conc r
15b0: 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d  ownum ":" colnum
15c0: 29 29 29 20 3b 3b 20 72 6f 77 6e 75 6d 20 3d 20  ))) ;; rownum = 
15d0: 30 20 69 73 20 74 68 65 20 68 65 61 64 65 72 0a  0 is the header.
15e0: 3b 3b 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69  ;; ;; (debug:pri
15f0: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f  nt 0 *default-lo
1600: 67 2d 70 6f 72 74 2a 20 22 74 65 73 74 2d 69 64  g-port* "test-id
1610: 73 20 22 20 74 65 73 74 2d 69 64 73 20 22 2c 20  s " test-ids ", 
1620: 74 65 73 74 73 2d 64 65 74 61 69 6c 2d 63 68 61  tests-detail-cha
1630: 6e 67 65 73 20 22 20 74 65 73 74 73 2d 64 65 74  nges " tests-det
1640: 61 69 6c 2d 63 68 61 6e 67 65 73 29 0a 3b 3b 20  ail-changes).;; 
1650: 20 20 20 20 0a 3b 3b 20 09 20 3b 3b 20 74 65 73      .;; . ;; tes
1660: 74 73 20 72 65 6c 61 74 65 64 20 73 74 75 66 66  ts related stuff
1670: 0a 3b 3b 20 09 20 3b 3b 20 28 61 6c 6c 2d 74 65  .;; . ;; (all-te
1680: 73 74 6e 61 6d 65 73 20 28 64 65 6c 65 74 65 2d  stnames (delete-
1690: 64 75 70 6c 69 63 61 74 65 73 20 28 6d 61 70 20  duplicates (map 
16a0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74  db:test-get-test
16b0: 6e 61 6d 65 20 74 65 73 74 2d 63 68 61 6e 67 65  name test-change
16c0: 73 29 29 29 29 0a 3b 3b 20 0a 3b 3b 20 20 20 20  s)))).;; .;;    
16d0: 20 3b 3b 20 47 69 76 65 6e 20 61 20 72 75 6e 2d   ;; Given a run-
16e0: 69 64 20 61 6e 64 20 74 65 73 74 6e 61 6d 65 2f  id and testname/
16f0: 69 74 65 6d 5f 70 61 74 68 20 63 61 6c 63 75 6c  item_path calcul
1700: 61 74 65 20 61 20 63 65 6c 6c 20 52 3a 43 0a 3b  ate a cell R:C.;
1710: 3b 20 0a 3b 3b 20 20 20 20 20 3b 3b 20 4e 4f 54  ; .;;     ;; NOT
1720: 45 3a 20 41 6c 73 6f 20 62 75 69 6c 64 20 74 68  E: Also build th
1730: 65 20 74 65 73 74 20 74 72 65 65 20 62 72 6f 77  e test tree brow
1740: 73 65 72 20 61 6e 64 20 6c 6f 6f 6b 20 75 70 20  ser and look up 
1750: 74 61 62 6c 65 0a 3b 3b 20 20 20 20 20 3b 3b 0a  table.;;     ;;.
1760: 3b 3b 20 20 20 20 20 3b 3b 20 45 61 63 68 20 72  ;;     ;; Each r
1770: 75 6e 20 69 73 20 75 6e 69 71 75 65 20 6f 6e 20  un is unique on 
1780: 69 74 73 20 6b 65 79 73 20 61 6e 64 20 72 75 6e  its keys and run
1790: 6e 61 6d 65 20 6f 72 20 72 75 6e 2d 69 64 2c 20  name or run-id, 
17a0: 73 74 6f 72 65 20 69 6e 20 68 61 73 68 20 6f 6e  store in hash on
17b0: 20 63 6f 6c 6e 75 6d 0a 3b 3b 20 20 20 20 20 28   colnum.;;     (
17c0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61  for-each (lambda
17d0: 20 28 72 75 6e 2d 69 64 29 0a 3b 3b 20 09 09 28   (run-id).;; ..(
17e0: 6c 65 74 2a 20 28 28 72 75 6e 2d 72 65 63 6f 72  let* ((run-recor
17f0: 64 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65  d (hash-table-re
1800: 66 2f 64 65 66 61 75 6c 74 20 72 75 6e 73 2d 68  f/default runs-h
1810: 61 73 68 20 72 75 6e 2d 69 64 20 23 66 29 29 0a  ash run-id #f)).
1820: 3b 3b 20 09 09 20 20 20 20 20 20 20 28 6b 65 79  ;; ..       (key
1830: 2d 76 61 6c 73 20 20 20 28 6d 61 70 20 28 6c 61  -vals   (map (la
1840: 6d 62 64 61 20 28 6b 65 79 29 28 64 62 3a 67 65  mbda (key)(db:ge
1850: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65  t-value-by-heade
1860: 72 20 72 75 6e 2d 72 65 63 6f 72 64 20 68 65 61  r run-record hea
1870: 64 65 72 20 6b 65 79 29 29 0a 3b 3b 20 09 09 09  der key)).;; ...
1880: 09 09 6b 65 79 73 29 29 0a 3b 3b 20 09 09 20 20  ..keys)).;; ..  
1890: 20 20 20 20 20 28 72 75 6e 2d 6e 61 6d 65 20 20       (run-name  
18a0: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62   (db:get-value-b
18b0: 79 2d 68 65 61 64 65 72 20 72 75 6e 2d 72 65 63  y-header run-rec
18c0: 6f 72 64 20 68 65 61 64 65 72 20 22 72 75 6e 6e  ord header "runn
18d0: 61 6d 65 22 29 29 0a 3b 3b 20 09 09 20 20 20 20  ame")).;; ..    
18e0: 20 20 20 28 63 6f 6c 2d 6e 61 6d 65 20 20 20 28     (col-name   (
18f0: 63 6f 6e 63 20 28 73 74 72 69 6e 67 2d 69 6e 74  conc (string-int
1900: 65 72 73 70 65 72 73 65 20 6b 65 79 2d 76 61 6c  ersperse key-val
1910: 73 20 22 5c 6e 22 29 20 22 5c 6e 22 20 72 75 6e  s "\n") "\n" run
1920: 2d 6e 61 6d 65 29 29 0a 3b 3b 20 09 09 20 20 20  -name)).;; ..   
1930: 20 20 20 20 28 72 75 6e 2d 70 61 74 68 20 20 20      (run-path   
1940: 28 61 70 70 65 6e 64 20 6b 65 79 2d 76 61 6c 73  (append key-vals
1950: 20 28 6c 69 73 74 20 72 75 6e 2d 6e 61 6d 65 29   (list run-name)
1960: 29 29 29 0a 3b 3b 20 09 09 20 20 28 68 61 73 68  ))).;; ..  (hash
1970: 2d 74 61 62 6c 65 2d 73 65 74 21 20 28 64 62 6f  -table-set! (dbo
1980: 61 72 64 3a 74 61 62 64 61 74 2d 72 75 6e 2d 6b  ard:tabdat-run-k
1990: 65 79 73 20 64 61 74 61 29 20 72 75 6e 2d 69 64  eys data) run-id
19a0: 20 72 75 6e 2d 70 61 74 68 29 0a 3b 3b 20 09 09   run-path).;; ..
19b0: 20 20 3b 3b 20 6d 6f 64 69 66 79 20 63 65 6c 6c    ;; modify cell
19c0: 20 2d 20 62 75 74 20 6f 6e 6c 79 20 69 66 20 63   - but only if c
19d0: 68 61 6e 67 65 64 0a 3b 3b 20 09 09 20 20 28 73  hanged.;; ..  (s
19e0: 65 74 21 20 63 68 61 6e 67 65 64 20 28 64 63 6f  et! changed (dco
19f0: 6d 6d 6f 6e 3a 6d 6f 64 69 66 69 79 2d 69 66 2d  mmon:modifiy-if-
1a00: 64 69 66 66 65 72 65 6e 74 20 28 64 62 6f 61 72  different (dboar
1a10: 64 3a 74 61 62 64 61 74 2d 72 75 6e 73 2d 6d 61  d:tabdat-runs-ma
1a20: 74 72 69 78 20 64 61 74 61 29 20 63 65 6c 6c 6e  trix data) celln
1a30: 61 6d 65 20 63 6f 6c 2d 6e 61 6d 65 20 63 68 61  ame col-name cha
1a40: 6e 67 65 64 29 29 0a 3b 3b 20 09 09 20 20 28 68  nged)).;; ..  (h
1a50: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72  ash-table-set! r
1a60: 75 6e 69 64 2d 74 6f 2d 63 6f 6c 20 72 75 6e 2d  unid-to-col run-
1a70: 69 64 20 28 6c 69 73 74 20 63 6f 6c 6e 75 6d 20  id (list colnum 
1a80: 72 75 6e 2d 72 65 63 6f 72 64 29 29 0a 3b 3b 20  run-record)).;; 
1a90: 09 09 20 20 3b 3b 20 48 65 72 65 20 77 65 20 75  ..  ;; Here we u
1aa0: 70 64 61 74 65 20 74 68 65 20 74 65 73 74 73 20  pdate the tests 
1ab0: 74 72 65 65 62 6f 78 20 61 6e 64 20 74 72 65 65  treebox and tree
1ac0: 20 6b 65 79 73 0a 3b 3b 20 09 09 20 20 28 74 72   keys.;; ..  (tr
1ad0: 65 65 3a 61 64 64 2d 6e 6f 64 65 20 28 64 62 6f  ee:add-node (dbo
1ae0: 61 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 73  ard:tabdat-tests
1af0: 2d 74 72 65 65 20 64 61 74 61 29 20 22 52 75 6e  -tree data) "Run
1b00: 73 22 20 28 61 70 70 65 6e 64 20 6b 65 79 2d 76  s" (append key-v
1b10: 61 6c 73 20 28 6c 69 73 74 20 72 75 6e 2d 6e 61  als (list run-na
1b20: 6d 65 29 29 0a 3b 3b 20 09 09 09 09 20 75 73 65  me)).;; .... use
1b30: 72 64 61 74 61 3a 20 28 63 6f 6e 63 20 22 72 75  rdata: (conc "ru
1b40: 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 29 29  n-id: " run-id))
1b50: 0a 3b 3b 20 09 09 20 20 28 73 65 74 21 20 63 6f  .;; ..  (set! co
1b60: 6c 6e 75 6d 20 28 2b 20 63 6f 6c 6e 75 6d 20 31  lnum (+ colnum 1
1b70: 29 29 29 29 0a 3b 3b 20 09 20 20 20 20 20 20 72  )))).;; .      r
1b80: 75 6e 2d 69 64 73 29 0a 3b 3b 20 0a 3b 3b 20 20  un-ids).;; .;;  
1b90: 20 20 20 3b 3b 20 53 63 61 6e 20 61 6c 6c 20 74     ;; Scan all t
1ba0: 65 73 74 73 20 74 6f 20 62 65 20 64 69 73 70 6c  ests to be displ
1bb0: 61 79 65 64 20 61 6e 64 20 6f 72 67 61 6e 69 73  ayed and organis
1bc0: 65 20 61 6c 6c 20 74 68 65 20 74 65 73 74 20 6e  e all the test n
1bd0: 61 6d 65 73 2c 20 72 65 73 70 65 63 74 69 6e 67  ames, respecting
1be0: 20 77 68 61 74 20 69 73 20 69 6e 20 74 68 65 20   what is in the 
1bf0: 68 61 73 68 20 74 61 62 6c 65 0a 3b 3b 20 20 20  hash table.;;   
1c00: 20 20 3b 3b 20 44 6f 20 74 68 69 73 20 61 6e 61    ;; Do this ana
1c10: 6c 79 73 69 73 20 69 6e 20 74 68 65 20 6f 72 64  lysis in the ord
1c20: 65 72 20 6f 66 20 74 68 65 20 72 75 6e 2d 69 64  er of the run-id
1c30: 73 2c 20 74 68 65 20 6d 6f 73 74 20 72 65 63 65  s, the most rece
1c40: 6e 74 20 72 75 6e 20 77 69 6e 73 0a 3b 3b 20 20  nt run wins.;;  
1c50: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61     (for-each (la
1c60: 6d 62 64 61 20 28 72 75 6e 2d 69 64 29 0a 3b 3b  mbda (run-id).;;
1c70: 20 09 09 28 6c 65 74 2a 20 28 28 72 75 6e 2d 70   ..(let* ((run-p
1c80: 61 74 68 20 20 20 20 20 20 20 28 68 61 73 68 2d  ath       (hash-
1c90: 74 61 62 6c 65 2d 72 65 66 20 28 64 62 6f 61 72  table-ref (dboar
1ca0: 64 3a 74 61 62 64 61 74 2d 72 75 6e 2d 6b 65 79  d:tabdat-run-key
1cb0: 73 20 64 61 74 61 29 20 72 75 6e 2d 69 64 29 29  s data) run-id))
1cc0: 0a 3b 3b 20 09 09 20 20 20 20 20 20 20 28 74 65  .;; ..       (te
1cd0: 73 74 2d 63 68 61 6e 67 65 73 20 20 20 28 68 61  st-changes   (ha
1ce0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 61 6c 6c  sh-table-ref all
1cf0: 2d 74 65 73 74 2d 63 68 61 6e 67 65 73 20 72 75  -test-changes ru
1d00: 6e 2d 69 64 29 29 0a 3b 3b 20 09 09 20 20 20 20  n-id)).;; ..    
1d10: 20 20 20 28 6e 65 77 2d 74 65 73 74 2d 64 61 74     (new-test-dat
1d20: 20 20 20 28 63 61 72 20 74 65 73 74 2d 63 68 61     (car test-cha
1d30: 6e 67 65 73 29 29 0a 3b 3b 20 09 09 20 20 20 20  nges)).;; ..    
1d40: 20 20 20 28 72 65 6d 6f 76 65 64 2d 74 65 73 74     (removed-test
1d50: 73 20 20 28 63 61 64 72 20 74 65 73 74 2d 63 68  s  (cadr test-ch
1d60: 61 6e 67 65 73 29 29 0a 3b 3b 20 09 09 20 20 20  anges)).;; ..   
1d70: 20 20 20 20 28 74 65 73 74 73 20 20 20 20 20 20      (tests      
1d80: 20 20 20 20 28 73 6f 72 74 20 28 6d 61 70 20 63      (sort (map c
1d90: 61 64 72 20 28 66 69 6c 74 65 72 20 28 6c 61 6d  adr (filter (lam
1da0: 62 64 61 20 28 74 65 73 74 72 65 63 29 0a 3b 3b  bda (testrec).;;
1db0: 20 09 09 09 09 09 09 09 09 20 28 65 71 3f 20 72   ........ (eq? r
1dc0: 75 6e 2d 69 64 20 28 64 62 3a 6d 69 6e 74 65 73  un-id (db:mintes
1dd0: 74 2d 67 65 74 2d 72 75 6e 5f 69 64 20 28 63 61  t-get-run_id (ca
1de0: 64 72 20 74 65 73 74 72 65 63 29 29 29 29 0a 3b  dr testrec)))).;
1df0: 3b 20 09 09 09 09 09 09 09 20 20 20 20 20 20 20  ; .......       
1e00: 6e 65 77 2d 74 65 73 74 2d 64 61 74 29 29 0a 3b  new-test-dat)).;
1e10: 3b 20 09 09 09 09 09 20 20 20 20 20 28 6c 61 6d  ; .....     (lam
1e20: 62 64 61 20 28 61 20 62 29 0a 3b 3b 20 09 09 09  bda (a b).;; ...
1e30: 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28  ..       (let ((
1e40: 74 69 6d 65 2d 61 20 28 64 62 3a 6d 69 6e 74 65  time-a (db:minte
1e50: 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d  st-get-event_tim
1e60: 65 20 61 29 29 0a 3b 3b 20 09 09 09 09 09 09 20  e a)).;; ...... 
1e70: 20 20 20 20 28 74 69 6d 65 2d 62 20 28 64 62 3a      (time-b (db:
1e80: 6d 69 6e 74 65 73 74 2d 67 65 74 2d 65 76 65 6e  mintest-get-even
1e90: 74 5f 74 69 6d 65 20 62 29 29 29 0a 3b 3b 20 09  t_time b))).;; .
1ea0: 09 09 09 09 09 20 28 3e 20 74 69 6d 65 2d 61 20  ..... (> time-a 
1eb0: 74 69 6d 65 2d 62 29 29 29 29 29 0a 3b 3b 20 09  time-b))))).;; .
1ec0: 09 20 20 20 20 20 20 20 3b 3b 20 74 65 73 74 2d  .       ;; test-
1ed0: 63 68 61 6e 67 65 73 20 69 73 20 61 20 6c 69 73  changes is a lis
1ee0: 74 20 6f 66 20 28 28 20 69 64 20 72 65 63 6f 72  t of (( id recor
1ef0: 64 20 29 20 2e 2e 2e 20 29 0a 3b 3b 20 09 09 20  d ) ... ).;; .. 
1f00: 20 20 20 20 20 20 3b 3b 20 47 65 74 20 6c 69 73        ;; Get lis
1f10: 74 20 6f 66 20 74 65 73 74 20 6e 61 6d 65 73 20  t of test names 
1f20: 73 6f 72 74 65 64 20 62 79 20 74 69 6d 65 2c 20  sorted by time, 
1f30: 72 65 6d 6f 76 65 20 74 65 73 74 73 0a 3b 3b 20  remove tests.;; 
1f40: 09 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e  ..       (test-n
1f50: 61 6d 65 73 20 28 64 65 6c 65 74 65 2d 64 75 70  ames (delete-dup
1f60: 6c 69 63 61 74 65 73 20 28 6d 61 70 20 28 6c 61  licates (map (la
1f70: 6d 62 64 61 20 28 74 29 0a 3b 3b 20 09 09 09 09  mbda (t).;; ....
1f80: 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 69  ...     (let ((i
1f90: 20 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74   (db:mintest-get
1fa0: 2d 69 74 65 6d 5f 70 61 74 68 20 74 29 29 0a 3b  -item_path t)).;
1fb0: 3b 20 09 09 09 09 09 09 09 09 20 20 20 28 6e 20  ; ........   (n 
1fc0: 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d  (db:mintest-get-
1fd0: 74 65 73 74 6e 61 6d 65 20 20 74 29 29 29 0a 3b  testname  t))).;
1fe0: 3b 20 09 09 09 09 09 09 09 20 20 20 20 20 20 20  ; .......       
1ff0: 28 69 66 20 28 73 74 72 69 6e 67 3d 3f 20 69 20  (if (string=? i 
2000: 22 22 29 0a 3b 3b 20 09 09 09 09 09 09 09 09 20  "").;; ........ 
2010: 20 20 28 63 6f 6e 63 20 22 20 20 20 22 20 69 29    (conc "   " i)
2020: 0a 3b 3b 20 09 09 09 09 09 09 09 09 20 20 20 6e  .;; ........   n
2030: 29 29 29 0a 3b 3b 20 09 09 09 09 09 09 09 20 20  ))).;; .......  
2040: 20 74 65 73 74 73 29 29 29 0a 3b 3b 20 09 09 20   tests))).;; .. 
2050: 20 20 20 20 20 20 28 63 6f 6c 6e 75 6d 20 20 20        (colnum   
2060: 20 20 28 63 61 72 20 28 68 61 73 68 2d 74 61 62    (car (hash-tab
2070: 6c 65 2d 72 65 66 20 72 75 6e 69 64 2d 74 6f 2d  le-ref runid-to-
2080: 63 6f 6c 20 72 75 6e 2d 69 64 29 29 29 29 0a 3b  col run-id)))).;
2090: 3b 20 09 09 20 20 3b 3b 20 66 6f 72 20 65 61 63  ; ..  ;; for eac
20a0: 68 20 74 65 73 74 20 6e 61 6d 65 20 67 65 74 20  h test name get 
20b0: 74 68 65 20 73 6c 6f 74 20 69 66 20 69 74 20 65  the slot if it e
20c0: 78 69 73 74 73 20 61 6e 64 20 66 69 6c 6c 20 69  xists and fill i
20d0: 6e 20 74 68 65 20 63 65 6c 6c 0a 3b 3b 20 09 09  n the cell.;; ..
20e0: 20 20 3b 3b 20 6f 72 20 74 61 6b 65 20 74 68 65    ;; or take the
20f0: 20 6e 65 78 74 20 73 6c 6f 74 20 61 6e 64 20 66   next slot and f
2100: 69 6c 6c 20 69 6e 20 74 68 65 20 63 65 6c 6c 2c  ill in the cell,
2110: 20 64 65 61 6c 20 77 69 74 68 20 69 74 65 6d 73   deal with items
2120: 20 69 6e 20 74 68 65 0a 3b 3b 20 09 09 20 20 3b   in the.;; ..  ;
2130: 3b 20 72 75 6e 20 76 69 65 77 20 70 61 6e 65 6c  ; run view panel
2140: 3f 20 54 68 65 20 72 75 6e 20 76 69 65 77 20 70  ? The run view p
2150: 61 6e 65 6c 20 63 61 6e 20 68 61 76 65 20 61 20  anel can have a 
2160: 74 72 65 65 20 73 65 6c 65 63 74 6f 72 20 66 6f  tree selector fo
2170: 72 0a 3b 3b 20 09 09 20 20 3b 3b 20 62 72 6f 77  r.;; ..  ;; brow
2180: 73 69 6e 67 20 74 68 65 20 74 65 73 74 73 2f 69  sing the tests/i
2190: 74 65 6d 73 0a 3b 3b 20 0a 3b 3b 20 09 09 20 20  tems.;; .;; ..  
21a0: 3b 3b 20 53 57 49 54 43 48 20 54 48 49 53 20 54  ;; SWITCH THIS T
21b0: 4f 20 55 53 49 4e 47 20 43 48 41 4e 47 45 44 20  O USING CHANGED 
21c0: 54 45 53 54 53 20 4f 4e 4c 59 0a 3b 3b 20 09 09  TESTS ONLY.;; ..
21d0: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d    (for-each (lam
21e0: 62 64 61 20 28 74 65 73 74 29 0a 3b 3b 20 09 09  bda (test).;; ..
21f0: 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74  .      (let* ((t
2200: 65 73 74 2d 69 64 20 20 20 28 64 62 3a 6d 69 6e  est-id   (db:min
2210: 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74  test-get-id test
2220: 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 28  )).;; ....     (
2230: 73 74 61 74 65 20 20 20 20 20 28 64 62 3a 6d 69  state     (db:mi
2240: 6e 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20  ntest-get-state 
2250: 74 65 73 74 29 29 0a 3b 3b 20 09 09 09 09 20 20  test)).;; ....  
2260: 20 20 20 28 73 74 61 74 75 73 20 20 20 20 28 64     (status    (d
2270: 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d 73 74  b:mintest-get-st
2280: 61 74 75 73 20 74 65 73 74 29 29 0a 3b 3b 20 09  atus test)).;; .
2290: 09 09 09 20 20 20 20 20 28 74 65 73 74 6e 61 6d  ...     (testnam
22a0: 65 20 20 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67  e  (db:mintest-g
22b0: 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74  et-testname test
22c0: 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 28  )).;; ....     (
22d0: 69 74 65 6d 70 61 74 68 20 20 28 64 62 3a 6d 69  itempath  (db:mi
22e0: 6e 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 5f 70  ntest-get-item_p
22f0: 61 74 68 20 74 65 73 74 29 29 0a 3b 3b 20 09 09  ath test)).;; ..
2300: 09 09 20 20 20 20 20 28 66 75 6c 6c 6e 61 6d 65  ..     (fullname
2310: 20 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65    (conc testname
2320: 20 22 2f 22 20 69 74 65 6d 70 61 74 68 29 29 0a   "/" itempath)).
2330: 3b 3b 20 09 09 09 09 20 20 20 20 20 28 64 69 73  ;; ....     (dis
2340: 70 6e 61 6d 65 20 20 28 69 66 20 28 73 74 72 69  pname  (if (stri
2350: 6e 67 3d 3f 20 69 74 65 6d 70 61 74 68 20 22 22  ng=? itempath ""
2360: 29 20 74 65 73 74 6e 61 6d 65 20 28 63 6f 6e 63  ) testname (conc
2370: 20 22 20 20 20 22 20 69 74 65 6d 70 61 74 68 29   "   " itempath)
2380: 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 28  )).;; ....     (
2390: 72 6f 77 6e 75 6d 20 20 20 20 28 68 61 73 68 2d  rownum    (hash-
23a0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c  table-ref/defaul
23b0: 74 20 74 65 73 74 6e 61 6d 65 2d 74 6f 2d 72 6f  t testname-to-ro
23c0: 77 20 66 75 6c 6c 6e 61 6d 65 20 23 66 29 29 0a  w fullname #f)).
23d0: 3b 3b 20 09 09 09 09 20 20 20 20 20 28 74 65 73  ;; ....     (tes
23e0: 74 2d 70 61 74 68 20 28 61 70 70 65 6e 64 20 72  t-path (append r
23f0: 75 6e 2d 70 61 74 68 20 28 69 66 20 28 65 71 75  un-path (if (equ
2400: 61 6c 3f 20 69 74 65 6d 70 61 74 68 20 22 22 29  al? itempath "")
2410: 20 0a 3b 3b 20 09 09 09 09 09 09 09 09 20 20 20   .;; ........   
2420: 20 20 28 6c 69 73 74 20 74 65 73 74 6e 61 6d 65    (list testname
2430: 29 0a 3b 3b 20 09 09 09 09 09 09 09 09 20 20 20  ).;; ........   
2440: 20 20 28 6c 69 73 74 20 74 65 73 74 6e 61 6d 65    (list testname
2450: 20 69 74 65 6d 70 61 74 68 29 29 29 29 0a 3b 3b   itempath)))).;;
2460: 20 09 09 09 09 20 20 20 20 20 28 74 62 20 20 20   ....     (tb   
2470: 20 20 20 20 20 20 28 64 62 6f 61 72 64 3a 74 61        (dboard:ta
2480: 62 64 61 74 2d 74 65 73 74 73 2d 74 72 65 65 20  bdat-tests-tree 
2490: 64 61 74 61 29 29 29 0a 3b 3b 20 09 09 09 09 28  data))).;; ....(
24a0: 70 72 69 6e 74 20 22 49 4e 46 4f 4e 4f 54 45 3a  print "INFONOTE:
24b0: 20 72 75 6e 2d 70 61 74 68 3a 20 22 20 72 75 6e   run-path: " run
24c0: 2d 70 61 74 68 29 0a 3b 3b 20 09 09 09 09 28 74  -path).;; ....(t
24d0: 72 65 65 3a 61 64 64 2d 6e 6f 64 65 20 28 64 62  ree:add-node (db
24e0: 6f 61 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74  oard:tabdat-test
24f0: 73 2d 74 72 65 65 20 64 61 74 61 29 20 22 52 75  s-tree data) "Ru
2500: 6e 73 22 20 0a 3b 3b 20 09 09 09 09 09 20 20 20  ns" .;; .....   
2510: 20 20 20 20 74 65 73 74 2d 70 61 74 68 0a 3b 3b      test-path.;;
2520: 20 09 09 09 09 09 20 20 20 20 20 20 20 75 73 65   .....       use
2530: 72 64 61 74 61 3a 20 28 63 6f 6e 63 20 22 74 65  rdata: (conc "te
2540: 73 74 2d 69 64 3a 20 22 20 74 65 73 74 2d 69 64  st-id: " test-id
2550: 29 29 0a 3b 3b 20 09 09 09 09 28 6c 65 74 20 28  )).;; ....(let (
2560: 28 6e 6f 64 65 2d 6e 75 6d 20 28 74 72 65 65 3a  (node-num (tree:
2570: 66 69 6e 64 2d 6e 6f 64 65 20 74 62 20 28 63 6f  find-node tb (co
2580: 6e 73 20 22 52 75 6e 73 22 20 74 65 73 74 2d 70  ns "Runs" test-p
2590: 61 74 68 29 29 29 0a 3b 3b 20 09 09 09 09 20 20  ath))).;; ....  
25a0: 20 20 20 20 28 63 6f 6c 6f 72 20 20 20 20 28 63      (color    (c
25b0: 61 72 20 28 67 75 74 69 6c 73 3a 67 65 74 2d 63  ar (gutils:get-c
25c0: 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73  olor-for-state-s
25d0: 74 61 74 75 73 20 73 74 61 74 65 20 73 74 61 74  tatus state stat
25e0: 75 73 29 29 29 29 0a 3b 3b 20 09 09 09 09 20 20  us)))).;; ....  
25f0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a  (debug:print 0 *
2600: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74  default-log-port
2610: 2a 20 22 6e 6f 64 65 2d 6e 75 6d 3a 20 22 20 6e  * "node-num: " n
2620: 6f 64 65 2d 6e 75 6d 20 22 2c 20 63 6f 6c 6f 72  ode-num ", color
2630: 3a 20 22 20 63 6f 6c 6f 72 29 0a 3b 3b 20 0a 3b  : " color).;; .;
2640: 3b 20 09 09 09 09 20 20 28 73 65 74 21 20 63 68  ; ....  (set! ch
2650: 61 6e 67 65 64 20 28 64 63 6f 6d 6d 6f 6e 3a 6d  anged (dcommon:m
2660: 6f 64 69 66 69 79 2d 69 66 2d 64 69 66 66 65 72  odifiy-if-differ
2670: 65 6e 74 20 0a 3b 3b 20 09 09 09 09 09 09 20 74  ent .;; ...... t
2680: 62 0a 3b 3b 20 09 09 09 09 09 09 20 28 63 6f 6e  b.;; ...... (con
2690: 63 20 22 43 4f 4c 4f 52 22 20 6e 6f 64 65 2d 6e  c "COLOR" node-n
26a0: 75 6d 29 0a 3b 3b 20 09 09 09 09 09 09 20 63 6f  um).;; ...... co
26b0: 6c 6f 72 20 63 68 61 6e 67 65 64 29 29 0a 3b 3b  lor changed)).;;
26c0: 20 0a 3b 3b 20 09 09 09 09 20 20 3b 3b 20 28 69   .;; ....  ;; (i
26d0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74  up:attribute-set
26e0: 21 20 74 62 20 28 63 6f 6e 63 20 22 43 4f 4c 4f  ! tb (conc "COLO
26f0: 52 22 20 6e 6f 64 65 2d 6e 75 6d 29 20 63 6f 6c  R" node-num) col
2700: 6f 72 29 0a 3b 3b 20 09 09 09 09 20 20 29 0a 3b  or).;; ....  ).;
2710: 3b 20 09 09 09 09 28 68 61 73 68 2d 74 61 62 6c  ; ....(hash-tabl
2720: 65 2d 73 65 74 21 20 28 64 62 6f 61 72 64 3a 74  e-set! (dboard:t
2730: 61 62 64 61 74 2d 70 61 74 68 2d 74 65 73 74 2d  abdat-path-test-
2740: 69 64 73 20 64 61 74 61 29 20 74 65 73 74 2d 70  ids data) test-p
2750: 61 74 68 20 74 65 73 74 2d 69 64 29 0a 3b 3b 20  ath test-id).;; 
2760: 09 09 09 09 28 69 66 20 28 6e 6f 74 20 72 6f 77  ....(if (not row
2770: 6e 75 6d 29 0a 3b 3b 20 09 09 09 09 20 20 20 20  num).;; ....    
2780: 28 6c 65 74 20 28 28 72 6f 77 6e 75 6d 73 20 28  (let ((rownums (
2790: 68 61 73 68 2d 74 61 62 6c 65 2d 76 61 6c 75 65  hash-table-value
27a0: 73 20 74 65 73 74 6e 61 6d 65 2d 74 6f 2d 72 6f  s testname-to-ro
27b0: 77 29 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 20  w))).;; ....    
27c0: 20 20 28 73 65 74 21 20 72 6f 77 6e 75 6d 20 28    (set! rownum (
27d0: 69 66 20 28 6e 75 6c 6c 3f 20 72 6f 77 6e 75 6d  if (null? rownum
27e0: 73 29 0a 3b 3b 20 09 09 09 09 09 09 20 20 20 20  s).;; ......    
27f0: 20 20 20 31 0a 3b 3b 20 09 09 09 09 09 09 20 20     1.;; ......  
2800: 20 20 20 20 20 28 2b 20 31 20 28 63 6f 6d 6d 6f       (+ 1 (commo
2810: 6e 3a 6d 61 78 20 72 6f 77 6e 75 6d 73 29 29 29  n:max rownums)))
2820: 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 20 28  ).;; ....      (
2830: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20  hash-table-set! 
2840: 74 65 73 74 6e 61 6d 65 2d 74 6f 2d 72 6f 77 20  testname-to-row 
2850: 66 75 6c 6c 6e 61 6d 65 20 72 6f 77 6e 75 6d 29  fullname rownum)
2860: 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 20 3b 3b  .;; ....      ;;
2870: 20 63 72 65 61 74 65 20 74 68 65 20 6c 61 62 65   create the labe
2880: 6c 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 20 28  l.;; ....      (
2890: 73 65 74 21 20 63 68 61 6e 67 65 64 20 28 64 63  set! changed (dc
28a0: 6f 6d 6d 6f 6e 3a 6d 6f 64 69 66 69 79 2d 69 66  ommon:modifiy-if
28b0: 2d 64 69 66 66 65 72 65 6e 74 20 0a 3b 3b 20 09  -different .;; .
28c0: 09 09 09 09 09 20 20 20 20 20 28 64 62 6f 61 72  .....     (dboar
28d0: 64 3a 74 61 62 64 61 74 2d 72 75 6e 73 2d 6d 61  d:tabdat-runs-ma
28e0: 74 72 69 78 20 64 61 74 61 29 0a 3b 3b 20 09 09  trix data).;; ..
28f0: 09 09 09 09 20 20 20 20 20 28 63 6f 6e 63 20 72  ....     (conc r
2900: 6f 77 6e 75 6d 20 22 3a 22 20 30 29 0a 3b 3b 20  ownum ":" 0).;; 
2910: 09 09 09 09 09 09 20 20 20 20 20 64 69 73 70 6e  ......     dispn
2920: 61 6d 65 0a 3b 3b 20 09 09 09 09 09 09 20 20 20  ame.;; ......   
2930: 20 20 63 68 61 6e 67 65 64 29 29 0a 3b 3b 20 09    changed)).;; .
2940: 09 09 09 20 20 20 20 20 20 3b 3b 20 28 69 75 70  ...      ;; (iup
2950: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20  :attribute-set! 
2960: 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 72  (dboard:tabdat-r
2970: 75 6e 73 2d 6d 61 74 72 69 78 20 64 61 74 61 29  uns-matrix data)
2980: 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 20 3b 3b  .;; ....      ;;
2990: 20 20 20 09 09 20 20 28 63 6f 6e 63 20 72 6f 77     ..  (conc row
29a0: 6e 75 6d 20 22 3a 22 20 30 29 20 64 69 73 70 6e  num ":" 0) dispn
29b0: 61 6d 65 29 0a 3b 3b 20 09 09 09 09 20 20 20 20  ame).;; ....    
29c0: 20 20 29 29 0a 3b 3b 20 09 09 09 09 3b 3b 20 73    )).;; ....;; s
29d0: 65 74 20 74 68 65 20 63 65 6c 6c 20 74 65 78 74  et the cell text
29e0: 20 61 6e 64 20 63 6f 6c 6f 72 0a 3b 3b 20 09 09   and color.;; ..
29f0: 09 09 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e  ..;; (debug:prin
2a00: 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67  t 2 *default-log
2a10: 2d 70 6f 72 74 2a 20 22 72 6f 77 6e 75 6d 3a 63  -port* "rownum:c
2a20: 6f 6c 6e 75 6d 3d 22 20 72 6f 77 6e 75 6d 20 22  olnum=" rownum "
2a30: 3a 22 20 63 6f 6c 6e 75 6d 20 22 2c 20 73 74 61  :" colnum ", sta
2a40: 74 65 3d 22 20 73 74 61 74 75 73 29 0a 3b 3b 20  te=" status).;; 
2a50: 09 09 09 09 28 73 65 74 21 20 63 68 61 6e 67 65  ....(set! change
2a60: 64 20 28 64 63 6f 6d 6d 6f 6e 3a 6d 6f 64 69 66  d (dcommon:modif
2a70: 69 79 2d 69 66 2d 64 69 66 66 65 72 65 6e 74 20  iy-if-different 
2a80: 0a 3b 3b 20 09 09 09 09 09 09 20 20 20 20 20 28  .;; ......     (
2a90: 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 72 75  dboard:tabdat-ru
2aa0: 6e 73 2d 6d 61 74 72 69 78 20 64 61 74 61 29 0a  ns-matrix data).
2ab0: 3b 3b 20 09 09 09 09 09 09 20 20 20 20 20 28 63  ;; ......     (c
2ac0: 6f 6e 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20 63  onc rownum ":" c
2ad0: 6f 6c 6e 75 6d 29 0a 3b 3b 20 09 09 09 09 09 09  olnum).;; ......
2ae0: 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72       (if (member
2af0: 20 73 74 61 74 65 20 27 28 22 41 52 43 48 49 56   state '("ARCHIV
2b00: 45 44 22 20 22 43 4f 4d 50 4c 45 54 45 44 22 29  ED" "COMPLETED")
2b10: 29 0a 3b 3b 20 09 09 09 09 09 09 09 20 73 74 61  ).;; ....... sta
2b20: 74 75 73 0a 3b 3b 20 09 09 09 09 09 09 09 20 73  tus.;; ....... s
2b30: 74 61 74 65 29 0a 3b 3b 20 09 09 09 09 09 09 20  tate).;; ...... 
2b40: 20 20 20 20 63 68 61 6e 67 65 64 29 29 0a 3b 3b      changed)).;;
2b50: 20 09 09 09 09 3b 3b 20 28 69 75 70 3a 61 74 74   ....;; (iup:att
2b60: 72 69 62 75 74 65 2d 73 65 74 21 20 28 64 62 6f  ribute-set! (dbo
2b70: 61 72 64 3a 74 61 62 64 61 74 2d 72 75 6e 73 2d  ard:tabdat-runs-
2b80: 6d 61 74 72 69 78 20 64 61 74 61 29 0a 3b 3b 20  matrix data).;; 
2b90: 09 09 09 09 3b 3b 20 09 09 20 20 20 20 28 63 6f  ....;; ..    (co
2ba0: 6e 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f  nc rownum ":" co
2bb0: 6c 6e 75 6d 29 0a 3b 3b 20 09 09 09 09 3b 3b 20  lnum).;; ....;; 
2bc0: 09 09 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65  ..    (if (membe
2bd0: 72 20 73 74 61 74 65 20 27 28 22 41 52 43 48 49  r state '("ARCHI
2be0: 56 45 44 22 20 22 43 4f 4d 50 4c 45 54 45 44 22  VED" "COMPLETED"
2bf0: 29 29 0a 3b 3b 20 09 09 09 09 3b 3b 20 09 09 09  )).;; ....;; ...
2c00: 73 74 61 74 75 73 0a 3b 3b 20 09 09 09 09 3b 3b  status.;; ....;;
2c10: 20 09 09 09 73 74 61 74 65 29 29 0a 3b 3b 20 09   ...state)).;; .
2c20: 09 09 09 28 73 65 74 21 20 63 68 61 6e 67 65 64  ...(set! changed
2c30: 20 28 64 63 6f 6d 6d 6f 6e 3a 6d 6f 64 69 66 69   (dcommon:modifi
2c40: 79 2d 69 66 2d 64 69 66 66 65 72 65 6e 74 20 0a  y-if-different .
2c50: 3b 3b 20 09 09 09 09 09 20 20 20 20 20 20 20 28  ;; .....       (
2c60: 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 72 75  dboard:tabdat-ru
2c70: 6e 73 2d 6d 61 74 72 69 78 20 64 61 74 61 29 0a  ns-matrix data).
2c80: 3b 3b 20 09 09 09 09 09 20 20 20 20 20 20 20 28  ;; .....       (
2c90: 63 6f 6e 63 20 22 42 47 43 4f 4c 4f 52 22 20 72  conc "BGCOLOR" r
2ca0: 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d  ownum ":" colnum
2cb0: 29 0a 3b 3b 20 09 09 09 09 09 20 20 20 20 20 20  ).;; .....      
2cc0: 20 28 63 61 72 20 28 67 75 74 69 6c 73 3a 67 65   (car (gutils:ge
2cd0: 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74  t-color-for-stat
2ce0: 65 2d 73 74 61 74 75 73 20 73 74 61 74 65 20 73  e-status state s
2cf0: 74 61 74 75 73 29 29 0a 3b 3b 20 09 09 09 09 09  tatus)).;; .....
2d00: 20 20 20 20 20 20 20 63 68 61 6e 67 65 64 29 29         changed))
2d10: 0a 3b 3b 20 09 09 09 09 3b 3b 20 28 69 75 70 3a  .;; ....;; (iup:
2d20: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 28  attribute-set! (
2d30: 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 72 75  dboard:tabdat-ru
2d40: 6e 73 2d 6d 61 74 72 69 78 20 64 61 74 61 29 0a  ns-matrix data).
2d50: 3b 3b 20 09 09 09 09 3b 3b 20 09 09 20 20 20 20  ;; ....;; ..    
2d60: 28 63 6f 6e 63 20 22 42 47 43 4f 4c 4f 52 22 20  (conc "BGCOLOR" 
2d70: 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75  rownum ":" colnu
2d80: 6d 29 0a 3b 3b 20 09 09 09 09 3b 3b 20 09 09 20  m).;; ....;; .. 
2d90: 20 20 20 28 63 61 72 20 28 67 75 74 69 6c 73 3a     (car (gutils:
2da0: 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74  get-color-for-st
2db0: 61 74 65 2d 73 74 61 74 75 73 20 73 74 61 74 65  ate-status state
2dc0: 20 73 74 61 74 75 73 29 29 29 0a 3b 3b 20 09 09   status))).;; ..
2dd0: 09 09 29 29 0a 3b 3b 20 09 09 09 20 20 20 20 74  ..)).;; ...    t
2de0: 65 73 74 73 29 29 29 0a 3b 3b 20 09 20 20 20 20  ests))).;; .    
2df0: 20 20 72 75 6e 2d 69 64 73 29 0a 3b 3b 20 0a 3b    run-ids).;; .;
2e00: 3b 20 20 20 20 20 28 6c 65 74 20 28 28 75 70 64  ;     (let ((upd
2e10: 61 74 65 72 20 28 68 61 73 68 2d 74 61 62 6c 65  ater (hash-table
2e20: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 20 28 64  -ref/default  (d
2e30: 62 6f 61 72 64 3a 63 6f 6d 6d 6f 6e 64 61 74 2d  board:commondat-
2e40: 75 70 64 61 74 65 72 73 20 63 6f 6d 6d 6f 6e 64  updaters commond
2e50: 61 74 29 20 77 69 6e 64 6f 77 2d 69 64 20 23 66  at) window-id #f
2e60: 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 28 69 66  ))).;;       (if
2e70: 20 75 70 64 61 74 65 72 20 28 75 70 64 61 74 65   updater (update
2e80: 72 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65  r (hash-table-re
2e90: 66 2f 64 65 66 61 75 6c 74 20 64 61 74 61 20 67  f/default data g
2ea0: 65 74 2d 64 65 74 61 69 6c 73 2d 73 69 67 20 23  et-details-sig #
2eb0: 66 29 29 29 29 0a 3b 3b 20 0a 3b 3b 20 20 20 20  f)))).;; .;;    
2ec0: 20 28 69 66 20 63 68 61 6e 67 65 64 20 28 69 75   (if changed (iu
2ed0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21  p:attribute-set!
2ee0: 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d   (dboard:tabdat-
2ef0: 72 75 6e 73 2d 6d 61 74 72 69 78 20 64 61 74 61  runs-matrix data
2f00: 29 20 22 52 45 44 52 41 57 22 20 22 41 4c 4c 22  ) "REDRAW" "ALL"
2f10: 29 29 0a 3b 3b 20 20 20 20 20 3b 3b 20 28 64 65  )).;;     ;; (de
2f20: 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66  bug:print 2 *def
2f30: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22  ault-log-port* "
2f40: 72 75 6e 2d 63 68 61 6e 67 65 73 3a 20 22 20 72  run-changes: " r
2f50: 75 6e 2d 63 68 61 6e 67 65 73 29 0a 3b 3b 20 20  un-changes).;;  
2f60: 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69     ;; (debug:pri
2f70: 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f  nt 2 *default-lo
2f80: 67 2d 70 6f 72 74 2a 20 22 74 65 73 74 2d 63 68  g-port* "test-ch
2f90: 61 6e 67 65 73 3a 20 22 20 74 65 73 74 2d 63 68  anges: " test-ch
2fa0: 61 6e 67 65 73 29 0a 3b 3b 20 20 20 20 20 28 6c  anges).;;     (l
2fb0: 69 73 74 20 72 75 6e 2d 63 68 61 6e 67 65 73 20  ist run-changes 
2fc0: 61 6c 6c 2d 74 65 73 74 2d 63 68 61 6e 67 65 73  all-test-changes
2fd0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63  )))..(define (dc
2fe0: 6f 6d 6d 6f 6e 3a 72 75 6e 73 64 61 74 2d 67 65  ommon:runsdat-ge
2ff0: 74 2d 63 6f 6c 2d 6e 75 6d 20 64 61 74 20 74 61  t-col-num dat ta
3000: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 66 6f 72  rget runname for
3010: 63 65 2d 73 65 74 29 0a 20 20 28 6c 65 74 2a 20  ce-set).  (let* 
3020: 28 28 72 75 6e 73 2d 69 6e 64 65 78 20 28 64 62  ((runs-index (db
3030: 6f 61 72 64 3a 72 75 6e 73 64 61 74 2d 72 75 6e  oard:runsdat-run
3040: 73 2d 69 6e 64 65 78 20 64 61 74 29 29 0a 09 20  s-index dat)).. 
3050: 28 63 6f 6c 2d 6e 61 6d 65 20 20 20 28 63 6f 6e  (col-name   (con
3060: 63 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e  c target "/" run
3070: 6e 61 6d 65 29 29 0a 09 20 28 72 65 73 20 20 20  name)).. (res   
3080: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65       (hash-table
3090: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 75 6e  -ref/default run
30a0: 73 2d 69 6e 64 65 78 20 63 6f 6c 2d 6e 61 6d 65  s-index col-name
30b0: 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 72   #f))).    (if r
30c0: 65 73 0a 09 72 65 73 0a 09 28 69 66 20 66 6f 72  es..res..(if for
30d0: 63 65 2d 73 65 74 0a 09 20 20 20 20 28 6c 65 74  ce-set..    (let
30e0: 20 28 28 6d 61 78 2d 63 6f 6c 2d 6e 75 6d 20 28   ((max-col-num (
30f0: 2b 20 31 20 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 20  + 1 (common:max 
3100: 28 63 6f 6e 73 2d 31 20 28 68 61 73 68 2d 74 61  (cons-1 (hash-ta
3110: 62 6c 65 2d 76 61 6c 75 65 73 20 72 75 6e 73 2d  ble-values runs-
3120: 69 6e 64 65 78 29 29 29 29 29 29 0a 09 20 20 20  index))))))..   
3130: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73     (hash-table-s
3140: 65 74 21 20 72 75 6e 73 2d 69 6e 64 65 78 20 63  et! runs-index c
3150: 6f 6c 2d 6e 61 6d 65 20 6d 61 78 2d 63 6f 6c 2d  ol-name max-col-
3160: 6e 75 6d 29 0a 09 20 20 20 20 20 20 6d 61 78 2d  num)..      max-
3170: 63 6f 6c 2d 6e 75 6d 29 29 29 29 29 0a 0a 28 64  col-num)))))..(d
3180: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 72  efine (dcommon:r
3190: 75 6e 73 64 61 74 2d 67 65 74 2d 72 6f 77 2d 6e  unsdat-get-row-n
31a0: 75 6d 20 64 61 74 20 74 65 73 74 6e 61 6d 65 20  um dat testname 
31b0: 69 74 65 6d 70 61 74 68 20 66 6f 72 63 65 2d 73  itempath force-s
31c0: 65 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65  et).  (let* ((te
31d0: 73 74 73 2d 69 6e 64 65 78 20 28 64 62 6f 61 72  sts-index (dboar
31e0: 64 3a 72 75 6e 73 64 61 74 2d 72 75 6e 73 2d 69  d:runsdat-runs-i
31f0: 6e 64 65 78 20 64 61 74 29 29 0a 09 20 28 72 6f  ndex dat)).. (ro
3200: 77 2d 6e 61 6d 65 20 20 20 20 28 63 6f 6e 63 20  w-name    (conc 
3210: 74 65 73 74 6e 61 6d 65 20 22 2f 22 20 69 74 65  testname "/" ite
3220: 6d 70 61 74 68 29 29 0a 09 20 28 72 65 73 20 20  mpath)).. (res  
3230: 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62         (hash-tab
3240: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72  le-ref/default r
3250: 75 6e 73 2d 69 6e 64 65 78 20 72 6f 77 2d 6e 61  uns-index row-na
3260: 6d 65 20 23 66 29 29 29 0a 20 20 20 20 28 69 66  me #f))).    (if
3270: 20 72 65 73 0a 09 72 65 73 0a 09 28 69 66 20 66   res..res..(if f
3280: 6f 72 63 65 2d 73 65 74 0a 09 20 20 20 20 28 6c  orce-set..    (l
3290: 65 74 20 28 28 6d 61 78 2d 72 6f 77 2d 6e 75 6d  et ((max-row-num
32a0: 20 28 2b 20 31 20 28 63 6f 6d 6d 6f 6e 3a 6d 61   (+ 1 (common:ma
32b0: 78 20 28 63 6f 6e 73 20 2d 31 20 28 68 61 73 68  x (cons -1 (hash
32c0: 2d 74 61 62 6c 65 2d 76 61 6c 75 65 73 20 74 65  -table-values te
32d0: 73 74 73 2d 69 6e 64 65 78 29 29 29 29 29 29 0a  sts-index)))))).
32e0: 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62  .      (hash-tab
32f0: 6c 65 2d 73 65 74 21 20 72 75 6e 73 2d 69 6e 64  le-set! runs-ind
3300: 65 78 20 72 6f 77 2d 6e 61 6d 65 20 6d 61 78 2d  ex row-name max-
3310: 72 6f 77 2d 6e 75 6d 29 0a 09 20 20 20 20 20 20  row-num)..      
3320: 6d 61 78 2d 72 6f 77 2d 6e 75 6d 29 29 29 29 29  max-row-num)))))
3330: 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d  ..(define (dcomm
3340: 6f 6e 3a 72 75 6e 64 61 74 2d 63 6f 70 79 2d 74  on:rundat-copy-t
3350: 65 73 74 73 2d 74 6f 2d 62 79 2d 6e 61 6d 65 20  ests-to-by-name 
3360: 72 75 6e 64 61 74 29 0a 20 20 28 6c 65 74 20 28  rundat).  (let (
3370: 28 73 72 63 2d 68 74 20 28 64 62 6f 61 72 64 3a  (src-ht (dboard:
3380: 72 75 6e 64 61 74 2d 74 65 73 74 73 20 72 75 6e  rundat-tests run
3390: 64 61 74 29 29 0a 09 28 74 72 67 2d 68 74 20 28  dat))..(trg-ht (
33a0: 64 62 6f 61 72 64 3a 72 75 6e 64 61 74 2d 74 65  dboard:rundat-te
33b0: 73 74 73 2d 62 79 2d 6e 61 6d 65 20 72 75 6e 64  sts-by-name rund
33c0: 61 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 61  at))).    (if (a
33d0: 6e 64 20 28 68 61 73 68 2d 74 61 62 6c 65 3f 20  nd (hash-table? 
33e0: 73 72 63 2d 68 74 29 28 68 61 73 68 2d 74 61 62  src-ht)(hash-tab
33f0: 6c 65 3f 20 74 72 67 2d 68 74 29 29 0a 09 28 62  le? trg-ht))..(b
3400: 65 67 69 6e 0a 09 20 20 28 68 61 73 68 2d 74 61  egin..  (hash-ta
3410: 62 6c 65 2d 63 6c 65 61 72 21 20 74 72 67 2d 68  ble-clear! trg-h
3420: 74 29 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 0a  t)..  (for-each.
3430: 09 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73  .   (lambda (tes
3440: 74 64 61 74 29 0a 09 20 20 20 20 20 28 68 61 73  tdat)..     (has
3450: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 72 67  h-table-set! trg
3460: 2d 68 74 20 28 74 65 73 74 3a 74 65 73 74 2d 67  -ht (test:test-g
3470: 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74  et-fullname test
3480: 64 61 74 29 20 74 65 73 74 64 61 74 29 29 0a 09  dat) testdat))..
3490: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 76     (hash-table-v
34a0: 61 6c 75 65 73 20 73 72 63 2d 68 74 29 29 29 0a  alues src-ht))).
34b0: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20  .(debug:print 0 
34c0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72  *default-log-por
34d0: 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 73 72 63  t* "WARNING: src
34e0: 2d 68 74 20 22 20 73 72 63 2d 68 74 20 22 20 74  -ht " src-ht " t
34f0: 72 67 2d 68 74 20 22 20 74 72 67 2d 68 74 29 29  rg-ht " trg-ht))
3500: 29 29 0a 20 20 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d  )).  ..;;=======
3510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a  ===============.
3550: 3b 3b 20 54 45 53 54 53 20 44 41 54 41 0a 3b 3b  ;; TESTS DATA.;;
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 3d 3d  ================
3580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
3590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
35a0: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 50 72 6f 64 75  ======..;; Produ
35b0: 63 65 20 61 20 6c 69 73 74 20 6f 66 20 6c 69 73  ce a list of lis
35c0: 74 73 20 72 65 61 64 79 20 66 6f 72 20 63 6f 6d  ts ready for com
35d0: 6d 6f 6e 3a 73 70 61 72 73 65 2d 6c 69 73 74 2d  mon:sparse-list-
35e0: 67 65 6e 65 72 61 74 65 2d 69 6e 64 65 78 0a 3b  generate-index.;
35f0: 3b 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d  ;.(define (dcomm
3600: 6f 6e 3a 6d 69 6e 69 6d 69 7a 65 2d 74 65 73 74  on:minimize-test
3610: 2d 64 61 74 61 20 74 65 73 74 73 2d 64 61 74 29  -data tests-dat)
3620: 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 65  .  (if (null? te
3630: 73 74 73 2d 64 61 74 29 20 0a 20 20 20 20 20 20  sts-dat) .      
3640: 27 28 29 0a 20 20 20 20 20 20 28 6c 65 74 20 6c  '().      (let l
3650: 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 74  oop ((hed (car t
3660: 65 73 74 73 2d 64 61 74 29 29 0a 09 09 20 28 74  ests-dat))... (t
3670: 61 6c 20 28 63 64 72 20 74 65 73 74 73 2d 64 61  al (cdr tests-da
3680: 74 29 29 0a 09 09 20 28 72 65 73 20 27 28 29 29  t))... (res '())
3690: 29 0a 09 28 6c 65 74 2a 20 28 28 74 65 73 74 2d  )..(let* ((test-
36a0: 69 64 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67  id    (db:test-g
36b0: 65 74 2d 69 64 20 68 65 64 29 29 20 3b 3b 20 6c  et-id hed)) ;; l
36c0: 6f 6f 6b 20 61 74 20 74 68 65 20 74 65 73 74 73  ook at the tests
36d0: 2d 64 61 74 20 73 70 65 63 20 66 6f 72 20 6c 6f  -dat spec for lo
36e0: 63 61 74 69 6f 6e 73 0a 09 20 20 20 20 20 20 20  cations..       
36f0: 28 74 65 73 74 2d 6e 61 6d 65 20 20 28 64 62 3a  (test-name  (db:
3700: 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d  test-get-testnam
3710: 65 20 68 65 64 29 29 0a 09 20 20 20 20 20 20 20  e hed))..       
3720: 28 69 74 65 6d 2d 70 61 74 68 20 20 28 64 62 3a  (item-path  (db:
3730: 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61  test-get-item-pa
3740: 74 68 20 68 65 64 29 29 0a 09 20 20 20 20 20 20  th hed))..      
3750: 20 28 73 74 61 74 65 20 20 20 20 20 20 28 64 62   (state      (db
3760: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20  :test-get-state 
3770: 68 65 64 29 29 0a 09 20 20 20 20 20 20 20 28 73  hed))..       (s
3780: 74 61 74 75 73 20 20 20 20 20 28 64 62 3a 74 65  tatus     (db:te
3790: 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 68 65  st-get-status he
37a0: 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  d)).            
37b0: 20 20 20 28 65 76 65 6e 74 2d 74 69 6d 65 20 28     (event-time (
37c0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e  db:test-get-even
37d0: 74 5f 74 69 6d 65 20 68 65 64 29 29 0a 09 20 20  t_time hed))..  
37e0: 20 20 20 20 20 28 6e 65 77 69 74 65 6d 20 20 20       (newitem   
37f0: 20 28 6c 69 73 74 20 74 65 73 74 2d 6e 61 6d 65   (list test-name
3800: 20 69 74 65 6d 2d 70 61 74 68 20 28 6c 69 73 74   item-path (list
3810: 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 20 73   test-id state s
3820: 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65  tatus event-time
3830: 29 29 29 29 0a 09 20 20 28 69 66 20 28 6e 75 6c  ))))..  (if (nul
3840: 6c 3f 20 74 61 6c 29 0a 09 20 20 20 20 20 20 28  l? tal)..      (
3850: 72 65 76 65 72 73 65 20 28 63 6f 6e 73 20 6e 65  reverse (cons ne
3860: 77 69 74 65 6d 20 72 65 73 29 29 0a 09 20 20 20  witem res))..   
3870: 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61     (loop (car ta
3880: 6c 29 28 63 64 72 20 74 61 6c 29 28 63 6f 6e 73  l)(cdr tal)(cons
3890: 20 6e 65 77 69 74 65 6d 20 72 65 73 29 29 29 29   newitem res))))
38a0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63  )))..(define (dc
38b0: 6f 6d 6d 6f 6e 3a 74 65 73 74 73 2d 6d 69 6e 64  ommon:tests-mind
38c0: 61 74 2d 3e 68 61 73 68 20 74 65 73 74 73 2d 6d  at->hash tests-m
38d0: 69 6e 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28  indat).  (let* (
38e0: 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d  (res (make-hash-
38f0: 74 61 62 6c 65 29 29 29 0a 20 20 20 20 28 66 6f  table))).    (fo
3900: 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d  r-each.     (lam
3910: 62 64 61 20 28 69 74 65 6d 29 0a 20 20 20 20 20  bda (item).     
3920: 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 6e    (let* ((test-n
3930: 61 6d 65 2b 69 74 65 6d 2d 70 61 74 68 20 28 63  ame+item-path (c
3940: 6f 6e 73 20 28 6c 69 73 74 2d 72 65 66 20 69 74  ons (list-ref it
3950: 65 6d 20 30 29 20 28 6c 69 73 74 2d 72 65 66 20  em 0) (list-ref 
3960: 69 74 65 6d 20 31 29 29 29 0a 20 20 20 20 20 20  item 1))).      
3970: 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 20 28          (value (
3980: 6c 69 73 74 2d 72 65 66 20 69 74 65 6d 20 32 29  list-ref item 2)
3990: 29 29 0a 20 20 20 20 20 20 20 20 20 28 68 61 73  )).         (has
39a0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73  h-table-set! res
39b0: 20 74 65 73 74 2d 6e 61 6d 65 2b 69 74 65 6d 2d   test-name+item-
39c0: 70 61 74 68 20 76 61 6c 75 65 29 29 29 0a 20 20  path value))).  
39d0: 20 20 20 74 65 73 74 73 2d 6d 69 6e 64 61 74 29     tests-mindat)
39e0: 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 72  .    res))..;; r
39f0: 65 74 75 72 6e 20 31 20 69 66 20 73 74 61 74 75  eturn 1 if statu
3a00: 73 31 20 69 73 20 62 65 74 74 65 72 0a 3b 3b 20  s1 is better.;; 
3a10: 72 65 74 75 72 6e 20 30 20 69 66 20 73 74 61 74  return 0 if stat
3a20: 75 73 31 20 61 6e 64 20 32 20 61 72 65 20 65 71  us1 and 2 are eq
3a30: 75 61 6c 6c 79 20 67 6f 6f 64 0a 3b 3b 20 72 65  ually good.;; re
3a40: 74 75 72 6e 20 2d 31 20 69 66 20 73 74 61 74 75  turn -1 if statu
3a50: 73 32 20 69 73 20 62 65 74 74 65 72 0a 28 64 65  s2 is better.(de
3a60: 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 73 74  fine (dcommon:st
3a70: 61 74 75 73 2d 63 6f 6d 70 61 72 65 33 20 73 74  atus-compare3 st
3a80: 61 74 75 73 31 20 73 74 61 74 75 73 32 29 0a 20  atus1 status2). 
3a90: 20 28 6c 65 74 2a 0a 20 20 20 20 20 20 28 28 73   (let*.      ((s
3aa0: 74 61 74 75 73 2d 67 6f 6f 64 6e 65 73 73 2d 72  tatus-goodness-r
3ab0: 61 6e 6b 69 6e 67 20 20 28 63 64 72 20 3b 3b 20  anking  (cdr ;; 
3ac0: 63 64 72 20 74 6f 20 64 72 6f 70 20 66 69 72 73  cdr to drop firs
3ad0: 74 20 69 74 65 6d 20 2d 2d 20 22 6e 2f 61 22 0a  t item -- "n/a".
3ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3b00: 20 20 28 61 70 70 65 6e 64 20 28 6d 61 70 20 63    (append (map c
3b10: 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 64 2d  adr *common:std-
3b20: 73 74 61 74 75 73 65 73 2a 29 0a 20 20 20 20 20  statuses*).     
3b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3b50: 20 20 20 20 20 27 28 23 66 29 29 20 3b 3b 20 61       '(#f)) ;; a
3b60: 6c 67 6f 72 69 74 68 6d 20 72 65 71 75 72 65 73  lgorithm requres
3b70: 20 6c 61 73 74 20 69 74 65 6d 20 74 6f 20 62 65   last item to be
3b80: 20 23 66 0a 20 20 20 20 20 20 20 20 20 20 20 20   #f.            
3b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3ba0: 20 20 20 20 20 20 29 20 20 29 0a 20 20 20 20 20        )  ).     
3bb0: 20 20 28 6d 65 6d 31 20 28 6d 65 6d 62 65 72 20    (mem1 (member 
3bc0: 73 74 61 74 75 73 31 20 73 74 61 74 75 73 2d 67  status1 status-g
3bd0: 6f 6f 64 6e 65 73 73 2d 72 61 6e 6b 69 6e 67 29  oodness-ranking)
3be0: 29 0a 20 20 20 20 20 20 20 28 6d 65 6d 32 20 28  ).       (mem2 (
3bf0: 6d 65 6d 62 65 72 20 73 74 61 74 75 73 32 20 73  member status2 s
3c00: 74 61 74 75 73 2d 67 6f 6f 64 6e 65 73 73 2d 72  tatus-goodness-r
3c10: 61 6e 6b 69 6e 67 29 29 0a 20 20 20 20 20 20 20  anking)).       
3c20: 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20  ).    (cond.    
3c30: 20 28 28 61 6e 64 20 28 6e 6f 74 20 6d 65 6d 31   ((and (not mem1
3c40: 29 20 28 6e 6f 74 20 6d 65 6d 32 29 29 20 30 29  ) (not mem2)) 0)
3c50: 0a 20 20 20 20 20 28 28 6e 6f 74 20 6d 65 6d 31  .     ((not mem1
3c60: 29 20 2d 31 29 0a 20 20 20 20 20 28 28 6e 6f 74  ) -1).     ((not
3c70: 20 6d 65 6d 32 29 20 31 29 0a 20 20 20 20 20 28   mem2) 1).     (
3c80: 28 3d 20 28 6c 65 6e 67 74 68 20 6d 65 6d 31 29  (= (length mem1)
3c90: 20 28 6c 65 6e 67 74 68 20 6d 65 6d 32 29 29 20   (length mem2)) 
3ca0: 30 29 0a 20 20 20 20 20 28 28 3e 20 28 6c 65 6e  0).     ((> (len
3cb0: 67 74 68 20 6d 65 6d 31 29 20 28 6c 65 6e 67 74  gth mem1) (lengt
3cc0: 68 20 6d 65 6d 32 29 29 20 31 29 0a 20 20 20 20  h mem2)) 1).    
3cd0: 20 28 65 6c 73 65 20 2d 31 29 29 29 29 0a 20 20   (else -1)))).  
3ce0: 20 20 20 0a 28 64 65 66 69 6e 65 20 28 64 63 6f     .(define (dco
3cf0: 6d 6d 6f 6e 3a 78 6f 72 2d 74 65 73 74 73 2d 6d  mmon:xor-tests-m
3d00: 69 6e 64 61 74 20 73 72 63 2d 74 65 73 74 73 2d  indat src-tests-
3d10: 6d 69 6e 64 61 74 20 64 65 73 74 2d 74 65 73 74  mindat dest-test
3d20: 73 2d 6d 69 6e 64 61 74 20 23 21 6b 65 79 20 28  s-mindat #!key (
3d30: 68 69 64 65 2d 63 6c 65 61 6e 20 23 66 29 29 0a  hide-clean #f)).
3d40: 20 20 28 6c 65 74 2a 20 28 28 73 72 63 2d 68 61    (let* ((src-ha
3d50: 73 68 20 28 64 63 6f 6d 6d 6f 6e 3a 74 65 73 74  sh (dcommon:test
3d60: 73 2d 6d 69 6e 64 61 74 2d 3e 68 61 73 68 20 73  s-mindat->hash s
3d70: 72 63 2d 74 65 73 74 73 2d 6d 69 6e 64 61 74 29  rc-tests-mindat)
3d80: 29 0a 20 20 20 20 20 20 20 20 20 28 64 65 73 74  ).         (dest
3d90: 2d 68 61 73 68 20 28 64 63 6f 6d 6d 6f 6e 3a 74  -hash (dcommon:t
3da0: 65 73 74 73 2d 6d 69 6e 64 61 74 2d 3e 68 61 73  ests-mindat->has
3db0: 68 20 64 65 73 74 2d 74 65 73 74 73 2d 6d 69 6e  h dest-tests-min
3dc0: 64 61 74 29 29 0a 20 20 20 20 20 20 20 20 20 28  dat)).         (
3dd0: 61 6c 6c 2d 6b 65 79 73 0a 20 20 20 20 20 20 20  all-keys.       
3de0: 20 20 20 28 72 65 76 65 72 73 65 20 28 73 6f 72     (reverse (sor
3df0: 74 20 0a 20 20 20 20 20 20 20 20 20 20 20 28 64  t .           (d
3e00: 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73  elete-duplicates
3e10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70  .            (ap
3e20: 70 65 6e 64 20 28 68 61 73 68 2d 74 61 62 6c 65  pend (hash-table
3e30: 2d 6b 65 79 73 20 73 72 63 2d 68 61 73 68 29 20  -keys src-hash) 
3e40: 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73  (hash-table-keys
3e50: 20 64 65 73 74 2d 68 61 73 68 29 29 29 0a 0a 20   dest-hash))).. 
3e60: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64            (lambd
3e70: 61 20 28 61 20 62 29 20 0a 20 20 20 20 20 20 20  a (a b) .       
3e80: 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20        (cond.    
3e90: 20 20 20 20 20 20 20 20 20 20 28 28 3c 20 30 20            ((< 0 
3ea0: 28 73 74 72 69 6e 67 2d 63 6f 6d 70 61 72 65 33  (string-compare3
3eb0: 20 28 63 61 72 20 61 29 20 28 63 61 72 20 62 29   (car a) (car b)
3ec0: 29 29 20 23 74 29 0a 20 20 20 20 20 20 20 20 20  )) #t).         
3ed0: 20 20 20 20 20 28 28 3e 20 30 20 28 73 74 72 69       ((> 0 (stri
3ee0: 6e 67 2d 63 6f 6d 70 61 72 65 33 20 28 63 61 72  ng-compare3 (car
3ef0: 20 61 29 20 28 63 61 72 20 62 29 29 29 20 23 66   a) (car b))) #f
3f00: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
3f10: 28 28 3c 20 30 20 28 73 74 72 69 6e 67 2d 63 6f  ((< 0 (string-co
3f20: 6d 70 61 72 65 33 20 28 63 64 72 20 61 29 20 28  mpare3 (cdr a) (
3f30: 63 64 72 20 62 29 29 29 20 23 74 29 0a 20 20 20  cdr b))) #t).   
3f40: 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65             (else
3f50: 20 23 66 29 29 29 0a 0a 20 20 20 20 20 20 20 20   #f)))..        
3f60: 20 20 20 29 29 29 29 0a 20 20 20 20 28 6c 65 74     )))).    (let
3f70: 20 28 28 72 65 73 0a 20 20 20 20 20 20 20 20 20   ((res.         
3f80: 20 20 28 6d 61 70 20 3b 3b 20 54 4f 44 4f 3a 20    (map ;; TODO: 
3f90: 72 65 6e 61 6d 65 20 78 6f 72 20 74 6f 20 64 65  rename xor to de
3fa0: 6c 74 61 20 67 6c 6f 62 61 6c 6c 79 20 69 6e 20  lta globally in 
3fb0: 64 63 6f 6d 6d 6f 6e 20 61 6e 64 20 64 61 73 68  dcommon and dash
3fc0: 62 6f 61 72 64 0a 20 20 20 20 20 20 20 20 20 20  board.          
3fd0: 20 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a    (lambda (key).
3fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c                (l
3ff0: 65 74 2a 20 28 28 74 65 73 74 2d 6e 61 6d 65 20  et* ((test-name 
4000: 28 63 61 72 20 6b 65 79 29 29 0a 20 20 20 20 20  (car key)).     
4010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4020: 28 69 74 65 6d 2d 70 61 74 68 20 28 63 64 72 20  (item-path (cdr 
4030: 6b 65 79 29 29 0a 0a 20 20 20 20 20 20 20 20 20  key))..         
4040: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 73              (des
4050: 74 2d 76 61 6c 75 65 20 28 68 61 73 68 2d 74 61  t-value (hash-ta
4060: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20  ble-ref/default 
4070: 64 65 73 74 2d 68 61 73 68 20 6b 65 79 20 23 66  dest-hash key #f
4080: 29 29 20 3b 3b 20 28 6c 69 73 74 20 74 65 73 74  )) ;; (list test
4090: 2d 69 64 20 73 74 61 74 65 20 73 74 61 74 75 73  -id state status
40a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
40b0: 20 20 20 20 20 20 20 28 64 65 73 74 2d 74 65 73         (dest-tes
40c0: 74 2d 69 64 20 20 28 69 66 20 64 65 73 74 2d 76  t-id  (if dest-v
40d0: 61 6c 75 65 20 28 6c 69 73 74 2d 72 65 66 20 64  alue (list-ref d
40e0: 65 73 74 2d 76 61 6c 75 65 20 30 29 20 23 66 29  est-value 0) #f)
40f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
4100: 20 20 20 20 20 20 20 28 64 65 73 74 2d 73 74 61         (dest-sta
4110: 74 65 20 20 20 20 28 69 66 20 64 65 73 74 2d 76  te    (if dest-v
4120: 61 6c 75 65 20 28 6c 69 73 74 2d 72 65 66 20 64  alue (list-ref d
4130: 65 73 74 2d 76 61 6c 75 65 20 31 29 20 23 66 29  est-value 1) #f)
4140: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
4150: 20 20 20 20 20 20 20 28 64 65 73 74 2d 73 74 61         (dest-sta
4160: 74 75 73 20 20 20 28 69 66 20 64 65 73 74 2d 76  tus   (if dest-v
4170: 61 6c 75 65 20 28 6c 69 73 74 2d 72 65 66 20 64  alue (list-ref d
4180: 65 73 74 2d 76 61 6c 75 65 20 32 29 20 23 66 29  est-value 2) #f)
4190: 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  )..             
41a0: 20 20 20 20 20 20 20 20 28 73 72 63 2d 76 61 6c          (src-val
41b0: 75 65 20 20 20 20 20 28 68 61 73 68 2d 74 61 62  ue     (hash-tab
41c0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 73  le-ref/default s
41d0: 72 63 2d 68 61 73 68 20 6b 65 79 20 23 66 29 29  rc-hash key #f))
41e0: 20 20 20 3b 3b 20 28 6c 69 73 74 20 74 65 73 74     ;; (list test
41f0: 2d 69 64 20 73 74 61 74 65 20 73 74 61 74 75 73  -id state status
4200: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
4210: 20 20 20 20 20 20 20 28 73 72 63 2d 74 65 73 74         (src-test
4220: 2d 69 64 20 20 20 28 69 66 20 73 72 63 2d 76 61  -id   (if src-va
4230: 6c 75 65 20 28 6c 69 73 74 2d 72 65 66 20 73 72  lue (list-ref sr
4240: 63 2d 76 61 6c 75 65 20 30 29 20 23 66 29 29 0a  c-value 0) #f)).
4250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4260: 20 20 20 20 20 28 73 72 63 2d 73 74 61 74 65 20       (src-state 
4270: 20 20 20 20 28 69 66 20 73 72 63 2d 76 61 6c 75      (if src-valu
4280: 65 20 28 6c 69 73 74 2d 72 65 66 20 73 72 63 2d  e (list-ref src-
4290: 76 61 6c 75 65 20 31 29 20 23 66 29 29 0a 20 20  value 1) #f)).  
42a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
42b0: 20 20 20 28 73 72 63 2d 73 74 61 74 75 73 20 20     (src-status  
42c0: 20 20 28 69 66 20 73 72 63 2d 76 61 6c 75 65 20    (if src-value 
42d0: 28 6c 69 73 74 2d 72 65 66 20 73 72 63 2d 76 61  (list-ref src-va
42e0: 6c 75 65 20 32 29 20 23 66 29 29 0a 0a 20 20 20  lue 2) #f))..   
42f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4300: 20 20 28 69 6e 63 6f 6d 70 6c 65 74 65 2d 73 74    (incomplete-st
4310: 61 74 75 73 65 73 20 27 28 22 44 45 4c 45 54 45  atuses '("DELETE
4320: 44 22 20 22 49 4e 43 4f 4d 50 4c 45 54 45 22 20  D" "INCOMPLETE" 
4330: 22 53 54 55 43 4b 2f 44 45 41 44 22 20 22 4e 2f  "STUCK/DEAD" "N/
4340: 41 22 29 29 20 3b 3b 20 69 66 20 61 6e 79 20 6f  A")) ;; if any o
4350: 66 20 74 68 65 73 65 20 73 74 61 74 75 73 65 73  f these statuses
4360: 20 61 70 70 6c 79 2c 20 74 72 65 61 74 20 74 65   apply, treat te
4370: 73 74 20 61 73 20 69 6e 63 6f 6d 70 6c 65 74 65  st as incomplete
4380: 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ..              
4390: 20 20 20 20 20 20 20 28 64 65 73 74 2d 63 6f 6d         (dest-com
43a0: 70 6c 65 74 65 0a 20 20 20 20 20 20 20 20 20 20  plete.          
43b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64              (and
43c0: 20 64 65 73 74 2d 76 61 6c 75 65 20 64 65 73 74   dest-value dest
43d0: 2d 73 74 61 74 65 20 64 65 73 74 2d 73 74 61 74  -state dest-stat
43e0: 75 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  us.             
43f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65                (e
4400: 71 75 61 6c 3f 20 64 65 73 74 2d 73 74 61 74 65  qual? dest-state
4410: 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 20 20   "COMPLETED").  
4420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4430: 20 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 6d           (not (m
4440: 65 6d 62 65 72 20 64 65 73 74 2d 73 74 61 74 75  ember dest-statu
4450: 73 20 69 6e 63 6f 6d 70 6c 65 74 65 2d 73 74 61  s incomplete-sta
4460: 74 75 73 65 73 29 29 29 29 0a 20 20 20 20 20 20  tuses)))).      
4470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
4480: 73 72 63 2d 63 6f 6d 70 6c 65 74 65 0a 20 20 20  src-complete.   
4490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
44a0: 20 20 20 28 61 6e 64 20 73 72 63 2d 76 61 6c 75     (and src-valu
44b0: 65 20 73 72 63 2d 73 74 61 74 65 20 73 72 63 2d  e src-state src-
44c0: 73 74 61 74 75 73 0a 20 20 20 20 20 20 20 20 20  status.         
44d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
44e0: 20 20 28 65 71 75 61 6c 3f 20 73 72 63 2d 73 74    (equal? src-st
44f0: 61 74 65 20 22 43 4f 4d 50 4c 45 54 45 44 22 29  ate "COMPLETED")
4500: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
4510: 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74              (not
4520: 20 28 6d 65 6d 62 65 72 20 73 72 63 2d 73 74 61   (member src-sta
4530: 74 75 73 20 69 6e 63 6f 6d 70 6c 65 74 65 2d 73  tus incomplete-s
4540: 74 61 74 75 73 65 73 29 29 29 29 0a 20 20 20 20  tatuses)))).    
4550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4560: 20 28 73 74 61 74 75 73 2d 63 6f 6d 70 61 72 65   (status-compare
4570: 2d 72 65 73 75 6c 74 20 28 64 63 6f 6d 6d 6f 6e  -result (dcommon
4580: 3a 73 74 61 74 75 73 2d 63 6f 6d 70 61 72 65 33  :status-compare3
4590: 20 73 72 63 2d 73 74 61 74 75 73 20 64 65 73 74   src-status dest
45a0: 2d 73 74 61 74 75 73 29 29 0a 20 20 20 20 20 20  -status)).      
45b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
45c0: 78 6f 72 2d 6e 65 77 2d 69 74 65 6d 0a 20 20 20  xor-new-item.   
45d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
45e0: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20     (cond.       
45f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4600: 3b 3b 20 63 6f 6d 70 6c 65 74 65 2c 20 66 6f 72  ;; complete, for
4610: 20 74 68 69 73 20 63 61 73 65 20 6d 65 61 6e 73   this case means
4620: 3a 20 73 74 61 74 65 3d 63 6f 6d 70 65 6c 74 65  : state=compelte
4630: 20 41 4e 44 20 73 74 61 74 75 73 20 6e 6f 74 20   AND status not 
4640: 69 6e 20 28 20 64 65 6c 65 74 65 64 20 75 6e 63  in ( deleted unc
4650: 6f 6d 70 6c 65 74 65 20 73 74 75 63 6b 2f 64 65  omplete stuck/de
4660: 61 64 20 6e 2f 61 20 29 0a 20 20 20 20 20 20 20  ad n/a ).       
4670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4680: 3b 3b 20 6e 65 69 74 68 65 72 20 63 6f 6d 70 6c  ;; neither compl
4690: 65 74 65 20 2d 3e 20 62 61 64 0a 0a 20 20 20 20  ete -> bad..    
46a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
46b0: 20 20 20 3b 3b 20 73 72 63 20 21 63 6f 6d 70 6c     ;; src !compl
46c0: 65 74 65 2c 20 64 65 73 74 20 63 6f 6d 70 6c 65  ete, dest comple
46d0: 74 65 20 2d 3e 20 62 65 74 74 65 72 0a 20 20 20  te -> better.   
46e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
46f0: 20 20 20 20 28 28 61 6e 64 20 28 6e 6f 74 20 64      ((and (not d
4700: 65 73 74 2d 63 6f 6d 70 6c 65 74 65 29 20 28 6e  est-complete) (n
4710: 6f 74 20 73 72 63 2d 63 6f 6d 70 6c 65 74 65 29  ot src-complete)
4720: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
4730: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20            (list 
4740: 64 65 73 74 2d 74 65 73 74 2d 69 64 20 22 42 4f  dest-test-id "BO
4750: 54 48 2d 42 41 44 22 20 22 42 4f 54 48 2d 49 4e  TH-BAD" "BOTH-IN
4760: 43 4f 4d 50 4c 45 54 45 22 29 29 0a 20 20 20 20  COMPLETE")).    
4770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4780: 20 20 20 28 28 6e 6f 74 20 64 65 73 74 2d 63 6f     ((not dest-co
4790: 6d 70 6c 65 74 65 29 0a 20 20 20 20 20 20 20 20  mplete).        
47a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
47b0: 28 6c 69 73 74 20 73 72 63 2d 74 65 73 74 2d 69  (list src-test-i
47c0: 64 20 22 44 49 46 46 2d 4d 49 53 53 49 4e 47 22  d "DIFF-MISSING"
47d0: 20 22 44 45 53 54 2d 49 4e 43 4f 4d 50 4c 45 54   "DEST-INCOMPLET
47e0: 45 22 29 29 20 20 0a 20 20 20 20 20 20 20 20 20  E"))  .         
47f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28                ((
4800: 6e 6f 74 20 73 72 63 2d 63 6f 6d 70 6c 65 74 65  not src-complete
4810: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
4820: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20            (list 
4830: 64 65 73 74 2d 74 65 73 74 2d 69 64 20 22 44 49  dest-test-id "DI
4840: 46 46 2d 4e 45 57 22 20 22 53 52 43 2d 49 4e 43  FF-NEW" "SRC-INC
4850: 4f 4d 50 4c 45 54 45 22 29 29 20 20 20 20 20 20  OMPLETE"))      
4860: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
4870: 20 20 20 20 20 20 20 20 28 28 61 6e 64 0a 20 20          ((and.  
4880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4890: 20 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 73         (equal? s
48a0: 72 63 2d 73 74 61 74 65 20 64 65 73 74 2d 73 74  rc-state dest-st
48b0: 61 74 65 29 0a 20 20 20 20 20 20 20 20 20 20 20  ate).           
48c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65                (e
48d0: 71 75 61 6c 3f 20 73 72 63 2d 73 74 61 74 75 73  qual? src-status
48e0: 20 64 65 73 74 2d 73 74 61 74 75 73 29 29 0a 20   dest-status)). 
48f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4900: 20 20 20 20 20 20 20 28 6c 69 73 74 20 64 65 73         (list des
4910: 74 2d 74 65 73 74 2d 69 64 20 20 28 63 6f 6e 63  t-test-id  (conc
4920: 20 22 43 4c 45 41 4e 22 29 20 28 63 6f 6e 63 20   "CLEAN") (conc 
4930: 22 43 4c 45 41 4e 2d 22 20 64 65 73 74 2d 73 74  "CLEAN-" dest-st
4940: 61 74 75 73 29 20 29 29 20 0a 20 20 20 20 20 20  atus) )) .      
4950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4960: 20 3b 3b 20 20 20 20 62 65 74 74 65 72 20 6f 72   ;;    better or
4970: 20 77 6f 72 73 65 3a 20 70 61 73 73 20 3e 20 77   worse: pass > w
4980: 61 72 6e 20 3e 20 77 61 69 76 65 64 20 3e 20 73  arn > waived > s
4990: 6b 69 70 20 3e 20 66 61 69 6c 20 3e 20 61 62 6f  kip > fail > abo
49a0: 72 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  rt.             
49b0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20            ;;    
49c0: 20 70 61 73 73 20 3e 20 77 61 72 6e 20 3e 20 77   pass > warn > w
49d0: 61 69 76 65 64 20 3e 20 73 6b 69 70 20 3e 20 66  aived > skip > f
49e0: 61 69 6c 20 3e 20 61 62 6f 72 74 0a 20 20 20 20  ail > abort.    
49f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4a00: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20     .            
4a10: 20 20 20 20 20 20 20 20 20 20 20 28 28 3d 20 31             ((= 1
4a20: 20 73 74 61 74 75 73 2d 63 6f 6d 70 61 72 65 2d   status-compare-
4a30: 72 65 73 75 6c 74 29 20 3b 3b 20 73 72 63 20 69  result) ;; src i
4a40: 73 20 62 65 74 74 65 72 2c 20 64 65 73 74 20 69  s better, dest i
4a50: 73 20 77 6f 72 73 65 0a 20 20 20 20 20 20 20 20  s worse.        
4a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4a70: 28 6c 69 73 74 20 64 65 73 74 2d 74 65 73 74 2d  (list dest-test-
4a80: 69 64 20 22 44 49 52 54 59 2d 57 4f 52 53 45 22  id "DIRTY-WORSE"
4a90: 20 28 63 6f 6e 63 20 73 72 63 2d 73 74 61 74 75   (conc src-statu
4aa0: 73 20 22 2d 3e 22 20 64 65 73 74 2d 73 74 61 74  s "->" dest-stat
4ab0: 75 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20  us))).          
4ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c               (el
4ad0: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  se.             
4ae0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74             (list
4af0: 20 64 65 73 74 2d 74 65 73 74 2d 69 64 20 22 44   dest-test-id "D
4b00: 49 52 54 59 2d 42 45 54 54 45 52 22 20 28 63 6f  IRTY-BETTER" (co
4b10: 6e 63 20 73 72 63 2d 73 74 61 74 75 73 20 22 2d  nc src-status "-
4b20: 3e 22 20 64 65 73 74 2d 73 74 61 74 75 73 29 29  >" dest-status))
4b30: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
4b40: 20 20 20 20 20 20 20 20 20 29 29 29 0a 20 20 20           ))).   
4b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69               (li
4b60: 73 74 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65  st test-name ite
4b70: 6d 2d 70 61 74 68 20 20 78 6f 72 2d 6e 65 77 2d  m-path  xor-new-
4b80: 69 74 65 6d 29 29 29 0a 20 20 20 20 20 20 20 20  item))).        
4b90: 20 20 20 20 61 6c 6c 2d 6b 65 79 73 29 29 29 0a      all-keys))).
4ba0: 0a 20 20 20 20 20 20 28 69 66 20 68 69 64 65 2d  .      (if hide-
4bb0: 63 6c 65 61 6e 0a 20 20 20 20 20 20 20 20 20 20  clean.          
4bc0: 28 66 69 6c 74 65 72 0a 20 20 20 20 20 20 20 20  (filter.        
4bd0: 20 20 20 28 6c 61 6d 62 64 61 20 28 69 74 65 6d     (lambda (item
4be0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 3b  ).             ;
4bf0: 3b 28 70 72 69 6e 74 20 69 74 65 6d 29 0a 20 20  ;(print item).  
4c00: 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 0a             (not.
4c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65                (e
4c20: 71 75 61 6c 3f 0a 20 20 20 20 20 20 20 20 20 20  qual?.          
4c30: 20 20 20 20 20 22 43 4c 45 41 4e 22 0a 20 20 20       "CLEAN".   
4c40: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73              (lis
4c50: 74 2d 72 65 66 20 28 6c 69 73 74 2d 72 65 66 20  t-ref (list-ref 
4c60: 69 74 65 6d 20 32 29 20 31 29 29 29 29 0a 20 20  item 2) 1)))).  
4c70: 20 20 20 20 20 20 20 20 20 72 65 73 29 0a 20 20           res).  
4c80: 20 20 20 20 20 20 20 20 72 65 73 29 29 29 29 0a          res)))).
4c90: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f  .(define (dcommo
4ca0: 6e 3a 65 78 61 6d 69 6e 65 2d 78 74 65 72 6d 20  n:examine-xterm 
4cb0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a  run-id test-id).
4cc0: 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 64 61    (let* ((testda
4cd0: 74 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d  t (rmt:get-test-
4ce0: 69 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69  info-by-id run-i
4cf0: 64 20 74 65 73 74 2d 69 64 29 29 29 0a 20 20 20  d test-id))).   
4d00: 20 28 69 66 20 28 6e 6f 74 20 74 65 73 74 64 61   (if (not testda
4d10: 74 29 0a 20 20 20 20 20 20 20 20 28 62 65 67 69  t).        (begi
4d20: 6e 0a 20 20 20 20 20 20 20 20 20 20 28 64 65 62  n.          (deb
4d30: 75 67 3a 70 72 69 6e 74 20 32 20 22 45 52 52 4f  ug:print 2 "ERRO
4d40: 52 3a 20 4e 6f 20 74 65 73 74 20 64 61 74 61 20  R: No test data 
4d50: 66 6f 75 6e 64 20 66 6f 72 20 74 65 73 74 20 22  found for test "
4d60: 20 74 65 73 74 2d 69 64 20 22 2c 20 65 78 69 74   test-id ", exit
4d70: 69 6e 67 22 29 0a 20 20 20 20 20 20 20 20 20 20  ing").          
4d80: 28 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 20  (exit 1)).      
4d90: 20 20 28 6c 65 74 2a 0a 20 20 20 20 20 20 20 20    (let*.        
4da0: 20 20 20 20 28 28 72 75 6e 64 69 72 20 20 20 20      ((rundir    
4db0: 20 20 20 20 28 69 66 20 74 65 73 74 64 61 74 20      (if testdat 
4dc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
4dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4de0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75   (db:test-get-ru
4df0: 6e 64 69 72 20 74 65 73 74 64 61 74 29 0a 20 20  ndir testdat).  
4e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f                lo
4e20: 67 66 69 6c 65 29 29 0a 20 20 20 20 20 20 20 20  gfile)).        
4e30: 20 20 20 20 20 28 74 65 73 74 66 75 6c 6c 6e 61       (testfullna
4e40: 6d 65 20 20 28 69 66 20 74 65 73 74 64 61 74 20  me  (if testdat 
4e50: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 75 6c  (db:test-get-ful
4e60: 6c 6e 61 6d 65 20 74 65 73 74 64 61 74 29 20 22  lname testdat) "
4e70: 47 61 74 68 65 72 69 6e 67 20 64 61 74 61 20 2e  Gathering data .
4e80: 2e 2e 22 29 29 0a 20 20 20 20 20 20 20 20 20 20  ..")).          
4e90: 20 20 20 28 78 74 65 72 6d 20 20 20 20 20 20 28     (xterm      (
4ea0: 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20  lambda ().      
4eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4ec0: 20 20 20 20 20 28 69 66 20 28 64 69 72 65 63 74       (if (direct
4ed0: 6f 72 79 2d 65 78 69 73 74 73 3f 20 72 75 6e 64  ory-exists? rund
4ee0: 69 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  ir).            
4ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4f00: 20 20 20 28 6c 65 74 2a 20 28 28 73 68 65 6c 6c     (let* ((shell
4f10: 20 28 69 66 20 28 67 65 74 2d 65 6e 76 69 72 6f   (if (get-enviro
4f20: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22  nment-variable "
4f30: 53 48 45 4c 4c 22 29 20 0a 20 20 20 20 20 20 20  SHELL") .       
4f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4f60: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20            (conc 
4f70: 22 2d 65 20 22 20 28 67 65 74 2d 65 6e 76 69 72  "-e " (get-envir
4f80: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20  onment-variable 
4f90: 22 53 48 45 4c 4c 22 29 29 0a 20 20 20 20 20 20  "SHELL")).      
4fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
4fc0: 20 20 20 20 20 20 20 20 20 20 20 22 22 29 29 0a             "")).
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 28 63 6f 6d 6d 61 6e 64 20 28        (command (
5000: 63 6f 6e 63 20 22 63 64 20 22 20 72 75 6e 64 69  conc "cd " rundi
5010: 72 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  r .             
5020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5040: 20 20 20 20 20 20 20 20 22 3b 6d 74 5f 78 74 65          ";mt_xte
5050: 72 6d 20 2d 54 20 5c 22 22 20 28 73 74 72 69 6e  rm -T \"" (strin
5060: 67 2d 74 72 61 6e 73 6c 61 74 65 20 74 65 73 74  g-translate test
5070: 66 75 6c 6c 6e 61 6d 65 20 22 28 29 22 20 22 20  fullname "()" " 
5080: 20 22 29 20 22 5c 22 20 22 20 73 68 65 6c 6c 20   ") "\" " shell 
5090: 22 26 22 29 29 29 0a 20 20 20 20 20 20 20 20 20  "&"))).         
50a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
50b0: 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22          (print "
50c0: 43 6f 6d 6d 61 6e 64 20 3d 22 20 63 6f 6d 6d 61  Command =" comma
50d0: 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  nd).            
50e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
50f0: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 77 69 74       (common:wit
5100: 68 6f 75 74 2d 76 61 72 73 0a 20 20 20 20 20 20  hout-vars.      
5110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5120: 20 20 20 20 20 20 20 20 20 20 20 20 63 6f 6d 6d              comm
5130: 61 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20  and.            
5140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5150: 20 20 20 20 20 20 22 4d 54 5f 2e 2a 22 29 29 0a        "MT_.*")).
5160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
5180: 6d 65 73 73 61 67 65 2d 77 69 6e 64 6f 77 20 20  message-window  
5190: 28 63 6f 6e 63 20 22 44 69 72 65 63 74 6f 72 79  (conc "Directory
51a0: 20 22 20 72 75 6e 64 69 72 20 22 20 6e 6f 74 20   " rundir " not 
51b0: 66 6f 75 6e 64 22 29 29 29 29 29 29 0a 20 20 20  found")))))).   
51c0: 20 20 20 20 20 20 20 28 78 74 65 72 6d 29 0a 20         (xterm). 
51d0: 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 20           (print 
51e0: 22 41 64 64 69 6e 67 20 78 74 65 72 6d 20 63 6f  "Adding xterm co
51f0: 64 65 22 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d  de")))))..;;====
5200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5240: 3d 3d 0a 3b 3b 20 44 20 41 20 54 20 41 20 20 20  ==.;; D A T A   
5250: 54 20 41 20 42 20 4c 20 45 20 53 0a 3b 3b 3d 3d  T A B L E S.;;==
5260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
5290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
52a0: 3d 3d 3d 3d 0a 0a 3b 3b 20 54 61 62 6c 65 20 6f  ====..;; Table o
52b0: 66 20 6b 65 79 73 0a 28 64 65 66 69 6e 65 20 28  f keys.(define (
52c0: 64 63 6f 6d 6d 6f 6e 3a 6b 65 79 73 2d 6d 61 74  dcommon:keys-mat
52d0: 72 69 78 20 72 61 77 63 6f 6e 66 69 67 29 0a 20  rix rawconfig). 
52e0: 20 28 6c 65 74 2a 20 28 28 63 75 72 72 2d 72 6f   (let* ((curr-ro
52f0: 77 2d 6e 75 6d 20 31 29 0a 20 20 20 20 20 20 20  w-num 1).       
5300: 20 20 28 6b 65 79 2d 76 61 6c 73 20 20 20 20 20    (key-vals     
5310: 28 63 6f 6e 66 69 67 66 3a 73 65 63 74 69 6f 6e  (configf:section
5320: 2d 76 61 72 73 20 72 61 77 63 6f 6e 66 69 67 20  -vars rawconfig 
5330: 22 66 69 65 6c 64 73 22 29 29 0a 20 20 20 20 20  "fields")).     
5340: 20 20 20 20 28 6b 65 79 73 2d 6d 61 74 72 69 78      (keys-matrix
5350: 20 20 28 69 75 70 3a 6d 61 74 72 69 78 0a 20 20    (iup:matrix.  
5360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5370: 20 20 20 20 20 20 23 3a 61 6c 69 67 6e 6d 65 6e        #:alignmen
5380: 74 31 20 22 41 4c 45 46 54 22 0a 20 20 20 20 20  t1 "ALEFT".     
5390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
53a0: 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53     #:expand "YES
53b0: 22 20 3b 3b 20 22 48 4f 52 49 5a 4f 4e 54 41 4c  " ;; "HORIZONTAL
53c0: 22 20 3b 3b 20 22 56 45 52 54 49 43 41 4c 22 0a  " ;; "VERTICAL".
53d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
53e0: 20 20 20 20 20 20 20 20 3b 3b 20 23 3a 73 63 72          ;; #:scr
53f0: 6f 6c 6c 62 61 72 20 22 59 45 53 22 0a 20 20 20  ollbar "YES".   
5400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5410: 20 20 20 20 20 23 3a 6e 75 6d 63 6f 6c 20 31 0a       #:numcol 1.
5420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5430: 20 20 20 20 20 20 20 20 23 3a 6e 75 6d 6c 69 6e          #:numlin
5440: 20 28 6c 65 6e 67 74 68 20 6b 65 79 2d 76 61 6c   (length key-val
5450: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  s).             
5460: 20 20 20 20 20 20 20 20 20 20 20 23 3a 6e 75 6d             #:num
5470: 63 6f 6c 2d 76 69 73 69 62 6c 65 20 31 0a 20 20  col-visible 1.  
5480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5490: 20 20 20 20 20 20 23 3a 6e 75 6d 6c 69 6e 2d 76        #:numlin-v
54a0: 69 73 69 62 6c 65 20 28 6c 65 6e 67 74 68 20 6b  isible (length k
54b0: 65 79 2d 76 61 6c 73 29 0a 20 20 20 20 20 20 20  ey-vals).       
54c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
54d0: 20 23 3a 63 6c 69 63 6b 2d 63 62 20 28 6c 61 6d   #:click-cb (lam
54e0: 62 64 61 20 28 6f 62 6a 20 6c 69 6e 20 63 6f 6c  bda (obj lin col
54f0: 20 73 74 61 74 75 73 29 0a 20 20 20 20 20 20 20   status).       
5500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70                (p
5520: 72 69 6e 74 20 22 6f 62 6a 3a 20 22 20 6f 62 6a  rint "obj: " obj
5530: 20 22 20 6c 69 6e 3a 20 22 20 6c 69 6e 20 22 20   " lin: " lin " 
5540: 63 6f 6c 3a 20 22 20 63 6f 6c 20 22 20 73 74 61  col: " col " sta
5550: 74 75 73 3a 20 22 20 73 74 61 74 75 73 29 29 29  tus: " status)))
5560: 29 29 0a 20 20 20 20 3b 3b 20 28 69 75 70 3a 61  )).    ;; (iup:a
5570: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6b 65  ttribute-set! ke
5580: 79 73 2d 6d 61 74 72 69 78 20 22 30 3a 30 22 20  ys-matrix "0:0" 
5590: 22 52 75 6e 20 4b 65 79 73 22 29 0a 20 20 20 20  "Run Keys").    
55a0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73  (iup:attribute-s
55b0: 65 74 21 20 6b 65 79 73 2d 6d 61 74 72 69 78 20  et! keys-matrix 
55c0: 22 57 49 44 54 48 30 22 20 30 29 0a 20 20 20 20  "WIDTH0" 0).    
55d0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73  (iup:attribute-s
55e0: 65 74 21 20 6b 65 79 73 2d 6d 61 74 72 69 78 20  et! keys-matrix 
55f0: 22 30 3a 31 22 20 22 4b 65 79 20 4e 61 6d 65 22  "0:1" "Key Name"
5600: 29 0a 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 74  ).    ;; (iup:at
5610: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6b 65 79  tribute-set! key
5620: 73 2d 6d 61 74 72 69 78 20 22 57 49 44 54 48 31  s-matrix "WIDTH1
5630: 22 20 22 31 30 30 22 29 0a 20 20 20 20 3b 3b 20  " "100").    ;; 
5640: 66 69 6c 6c 20 69 6e 20 6b 65 79 73 0a 20 20 20  fill in keys.   
5650: 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20   (for-each .    
5660: 20 28 6c 61 6d 62 64 61 20 28 76 61 72 29 0a 20   (lambda (var). 
5670: 20 20 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 74        ;; (iup:at
5680: 74 72 69 62 75 74 65 2d 73 65 74 21 20 6b 65 79  tribute-set! key
5690: 73 2d 6d 61 74 72 69 78 20 22 41 44 44 4c 49 4e  s-matrix "ADDLIN
56a0: 22 20 28 63 6f 6e 63 20 63 75 72 72 2d 72 6f 77  " (conc curr-row
56b0: 2d 6e 75 6d 29 29 0a 20 20 20 20 20 20 20 28 69  -num)).       (i
56c0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74  up:attribute-set
56d0: 21 20 6b 65 79 73 2d 6d 61 74 72 69 78 20 28 63  ! keys-matrix (c
56e0: 6f 6e 63 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d  onc curr-row-num
56f0: 20 22 3a 30 22 29 20 63 75 72 72 2d 72 6f 77 2d   ":0") curr-row-
5700: 6e 75 6d 29 0a 20 20 20 20 20 20 20 28 69 75 70  num).       (iup
5710: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20  :attribute-set! 
5720: 6b 65 79 73 2d 6d 61 74 72 69 78 20 28 63 6f 6e  keys-matrix (con
5730: 63 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 22  c curr-row-num "
5740: 3a 31 22 29 20 76 61 72 29 0a 20 20 20 20 20 20  :1") var).      
5750: 20 28 73 65 74 21 20 63 75 72 72 2d 72 6f 77 2d   (set! curr-row-
5760: 6e 75 6d 20 28 2b 20 31 20 63 75 72 72 2d 72 6f  num (+ 1 curr-ro
5770: 77 2d 6e 75 6d 29 29 29 20 3b 3b 20 28 63 6f 6e  w-num))) ;; (con
5780: 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66  fig-lookup *conf
5790: 69 67 64 61 74 2a 20 22 66 69 65 6c 64 73 22 20  igdat* "fields" 
57a0: 76 61 72 29 29 29 0a 20 20 20 20 20 6b 65 79 2d  var))).     key-
57b0: 76 61 6c 73 29 0a 20 20 20 20 28 69 75 70 3a 61  vals).    (iup:a
57c0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 6b 65  ttribute-set! ke
57d0: 79 73 2d 6d 61 74 72 69 78 20 22 57 49 44 54 48  ys-matrix "WIDTH
57e0: 44 45 46 22 20 22 34 30 22 29 0a 20 20 20 20 6b  DEF" "40").    k
57f0: 65 79 73 2d 6d 61 74 72 69 78 29 29 0a 0a 3b 3b  eys-matrix))..;;
5800: 20 53 65 63 74 69 6f 6e 20 74 6f 20 74 61 62 6c   Section to tabl
5810: 65 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d  e.(define (dcomm
5820: 6f 6e 3a 73 65 63 74 69 6f 6e 2d 6d 61 74 72 69  on:section-matri
5830: 78 20 72 61 77 63 6f 6e 66 69 67 20 73 65 63 74  x rawconfig sect
5840: 69 6f 6e 6e 61 6d 65 20 76 61 72 63 6f 6c 6e 61  ionname varcolna
5850: 6d 65 20 76 61 6c 63 6f 6c 6e 61 6d 65 20 23 21  me valcolname #!
5860: 6b 65 79 20 28 74 69 74 6c 65 20 23 66 29 29 0a  key (title #f)).
5870: 20 20 28 6c 65 74 2a 20 28 28 63 75 72 72 2d 72    (let* ((curr-r
5880: 6f 77 2d 6e 75 6d 20 20 20 20 31 29 0a 20 20 20  ow-num    1).   
5890: 20 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20        (key-vals 
58a0: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a         (configf:
58b0: 73 65 63 74 69 6f 6e 2d 76 61 72 73 20 72 61 77  section-vars raw
58c0: 63 6f 6e 66 69 67 20 73 65 63 74 69 6f 6e 6e 61  config sectionna
58d0: 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 73  me)).         (s
58e0: 65 63 74 69 6f 6e 2d 6d 61 74 72 69 78 20 20 28  ection-matrix  (
58f0: 69 75 70 3a 6d 61 74 72 69 78 0a 20 20 20 20 20  iup:matrix.     
5900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5910: 20 20 20 20 20 20 23 3a 61 6c 69 67 6e 6d 65 6e        #:alignmen
5920: 74 31 20 22 41 4c 45 46 54 22 0a 20 20 20 20 20  t1 "ALEFT".     
5930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5940: 20 20 20 20 20 20 3b 3b 20 23 3a 65 78 70 61 6e        ;; #:expan
5950: 64 20 22 59 45 53 22 20 3b 3b 20 22 48 4f 52 49  d "YES" ;; "HORI
5960: 5a 4f 4e 54 41 4c 22 0a 20 20 20 20 20 20 20 20  ZONTAL".        
5970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5980: 20 20 20 23 3a 6e 75 6d 63 6f 6c 20 31 0a 20 20     #:numcol 1.  
5990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
59a0: 20 20 20 20 20 20 20 20 20 23 3a 6e 75 6d 6c 69           #:numli
59b0: 6e 20 28 6c 65 6e 67 74 68 20 6b 65 79 2d 76 61  n (length key-va
59c0: 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  ls).            
59d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23                 #
59e0: 3a 6e 75 6d 63 6f 6c 2d 76 69 73 69 62 6c 65 20  :numcol-visible 
59f0: 31 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  1.              
5a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 23 3a 6e               #:n
5a10: 75 6d 6c 69 6e 2d 76 69 73 69 62 6c 65 20 28 6d  umlin-visible (m
5a20: 69 6e 20 31 30 20 28 6c 65 6e 67 74 68 20 6b 65  in 10 (length ke
5a30: 79 2d 76 61 6c 73 29 29 0a 09 09 09 20 20 20 23  y-vals))....   #
5a40: 3a 73 63 72 6f 6c 6c 62 61 72 20 22 59 45 53 22  :scrollbar "YES"
5a50: 29 29 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74  ))).    (iup:att
5a60: 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 63 74  ribute-set! sect
5a70: 69 6f 6e 2d 6d 61 74 72 69 78 20 22 30 3a 30 22  ion-matrix "0:0"
5a80: 20 76 61 72 63 6f 6c 6e 61 6d 65 29 0a 20 20 20   varcolname).   
5a90: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d   (iup:attribute-
5aa0: 73 65 74 21 20 73 65 63 74 69 6f 6e 2d 6d 61 74  set! section-mat
5ab0: 72 69 78 20 22 30 3a 31 22 20 76 61 6c 63 6f 6c  rix "0:1" valcol
5ac0: 6e 61 6d 65 29 0a 20 20 20 20 28 69 75 70 3a 61  name).    (iup:a
5ad0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 65  ttribute-set! se
5ae0: 63 74 69 6f 6e 2d 6d 61 74 72 69 78 20 22 57 49  ction-matrix "WI
5af0: 44 54 48 31 22 20 22 32 30 30 22 29 0a 20 20 20  DTH1" "200").   
5b00: 20 3b 3b 20 66 69 6c 6c 20 69 6e 20 6b 65 79 73   ;; fill in keys
5b10: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a  .    (for-each .
5b20: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 61       (lambda (va
5b30: 72 29 0a 20 20 20 20 20 20 20 3b 3b 20 28 69 75  r).       ;; (iu
5b40: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21  p:attribute-set!
5b50: 20 6b 65 79 73 2d 6d 61 74 72 69 78 20 22 41 44   keys-matrix "AD
5b60: 44 4c 49 4e 22 20 28 63 6f 6e 63 20 63 75 72 72  DLIN" (conc curr
5b70: 2d 72 6f 77 2d 6e 75 6d 29 29 0a 20 20 20 20 20  -row-num)).     
5b80: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65    (iup:attribute
5b90: 2d 73 65 74 21 20 73 65 63 74 69 6f 6e 2d 6d 61  -set! section-ma
5ba0: 74 72 69 78 20 28 63 6f 6e 63 20 63 75 72 72 2d  trix (conc curr-
5bb0: 72 6f 77 2d 6e 75 6d 20 22 3a 30 22 29 20 76 61  row-num ":0") va
5bc0: 72 29 0a 20 20 20 20 20 20 20 28 69 75 70 3a 61  r).       (iup:a
5bd0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 65  ttribute-set! se
5be0: 63 74 69 6f 6e 2d 6d 61 74 72 69 78 20 28 63 6f  ction-matrix (co
5bf0: 6e 63 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 20  nc curr-row-num 
5c00: 22 3a 31 22 29 20 28 63 6f 6e 66 69 67 66 3a 6c  ":1") (configf:l
5c10: 6f 6f 6b 75 70 20 72 61 77 63 6f 6e 66 69 67 20  ookup rawconfig 
5c20: 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 29  sectionname var)
5c30: 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 63  ).       (set! c
5c40: 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 28 2b 20 31  urr-row-num (+ 1
5c50: 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 29 29 29   curr-row-num)))
5c60: 20 3b 3b 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b   ;; (config-look
5c70: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22  up *configdat* "
5c80: 66 69 65 6c 64 73 22 20 76 61 72 29 29 29 0a 20  fields" var))). 
5c90: 20 20 20 20 6b 65 79 2d 76 61 6c 73 29 0a 20 20      key-vals).  
5ca0: 20 20 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 20    (iup:vbox.    
5cb0: 20 28 69 75 70 3a 6c 61 62 65 6c 20 28 69 66 20   (iup:label (if 
5cc0: 74 69 74 6c 65 20 74 69 74 6c 65 20 28 63 6f 6e  title title (con
5cd0: 63 20 22 53 65 74 74 69 6e 67 73 20 66 72 6f 6d  c "Settings from
5ce0: 20 5b 22 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20   [" sectionname 
5cf0: 22 5d 22 29 29 20 20 0a 20 20 20 20 20 20 20 20  "]"))  .        
5d00: 20 09 3b 3b 20 23 3a 73 69 7a 65 20 20 20 22 35   .;; #:size   "5
5d10: 78 22 0a 20 20 20 20 20 20 20 20 20 09 23 3a 65  x".         .#:e
5d20: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41  xpand "HORIZONTA
5d30: 4c 22 0a 20 20 20 20 20 20 20 20 20 09 29 0a 20  L".         .). 
5d40: 20 20 20 20 73 65 63 74 69 6f 6e 2d 6d 61 74 72      section-matr
5d50: 69 78 29 29 29 0a 20 20 20 20 0a 3b 3b 20 47 65  ix))).    .;; Ge
5d60: 6e 65 72 61 6c 20 64 61 74 61 0a 3b 3b 0a 28 64  neral data.;;.(d
5d70: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 67  efine (dcommon:g
5d80: 65 6e 65 72 61 6c 2d 69 6e 66 6f 29 0a 20 20 28  eneral-info).  (
5d90: 6c 65 74 20 28 28 67 65 6e 65 72 61 6c 2d 6d 61  let ((general-ma
5da0: 74 72 69 78 20 28 69 75 70 3a 6d 61 74 72 69 78  trix (iup:matrix
5db0: 0a 09 09 09 20 23 3a 61 6c 69 67 6e 6d 65 6e 74  .... #:alignment
5dc0: 31 20 22 41 4c 45 46 54 22 0a 09 09 09 20 23 3a  1 "ALEFT".... #:
5dd0: 65 78 70 61 6e 64 20 22 59 45 53 22 20 3b 3b 20  expand "YES" ;; 
5de0: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09  "HORIZONTAL"....
5df0: 20 23 3a 6e 75 6d 63 6f 6c 20 31 0a 09 09 09 20   #:numcol 1.... 
5e00: 23 3a 6e 75 6d 6c 69 6e 20 32 0a 09 09 09 20 23  #:numlin 2.... #
5e10: 3a 6e 75 6d 63 6f 6c 2d 76 69 73 69 62 6c 65 20  :numcol-visible 
5e20: 31 0a 09 09 09 20 23 3a 6e 75 6d 6c 69 6e 2d 76  1.... #:numlin-v
5e30: 69 73 69 62 6c 65 20 32 29 29 29 0a 20 20 20 20  isible 2))).    
5e40: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73  (iup:attribute-s
5e50: 65 74 21 20 67 65 6e 65 72 61 6c 2d 6d 61 74 72  et! general-matr
5e60: 69 78 20 22 57 49 44 54 48 31 22 20 22 31 35 30  ix "WIDTH1" "150
5e70: 22 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72  ").    (iup:attr
5e80: 69 62 75 74 65 2d 73 65 74 21 20 67 65 6e 65 72  ibute-set! gener
5e90: 61 6c 2d 6d 61 74 72 69 78 20 22 30 3a 31 22 20  al-matrix "0:1" 
5ea0: 22 41 62 6f 75 74 20 74 68 69 73 20 4d 65 67 61  "About this Mega
5eb0: 74 65 73 74 20 61 72 65 61 22 29 20 0a 20 20 20  test area") .   
5ec0: 20 3b 3b 20 55 73 65 72 20 28 74 68 69 73 20 69   ;; User (this i
5ed0: 73 20 6e 6f 74 20 61 6c 77 61 79 73 20 6f 62 76  s not always obv
5ee0: 69 6f 75 73 20 2d 20 69 74 20 69 73 20 63 6f 6d  ious - it is com
5ef0: 6d 6f 6e 20 74 6f 20 72 75 6e 20 61 73 20 61 20  mon to run as a 
5f00: 64 69 66 66 65 72 65 6e 74 20 75 73 65 72 0a 20  different user. 
5f10: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74     (iup:attribut
5f20: 65 2d 73 65 74 21 20 67 65 6e 65 72 61 6c 2d 6d  e-set! general-m
5f30: 61 74 72 69 78 20 22 31 3a 30 22 20 22 55 73 65  atrix "1:0" "Use
5f40: 72 22 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74  r").    (iup:att
5f50: 72 69 62 75 74 65 2d 73 65 74 21 20 67 65 6e 65  ribute-set! gene
5f60: 72 61 6c 2d 6d 61 74 72 69 78 20 22 31 3a 31 22  ral-matrix "1:1"
5f70: 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e   (current-user-n
5f80: 61 6d 65 29 29 0a 20 20 20 20 3b 3b 20 4d 65 67  ame)).    ;; Meg
5f90: 61 74 65 73 74 20 61 72 65 61 0a 20 20 20 20 3b  atest area.    ;
5fa0: 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65  ; (iup:attribute
5fb0: 2d 73 65 74 21 20 67 65 6e 65 72 61 6c 2d 6d 61  -set! general-ma
5fc0: 74 72 69 78 20 22 32 3a 30 22 20 22 41 72 65 61  trix "2:0" "Area
5fd0: 22 29 0a 20 20 20 20 3b 3b 20 28 69 75 70 3a 61  ").    ;; (iup:a
5fe0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 67 65  ttribute-set! ge
5ff0: 6e 65 72 61 6c 2d 6d 61 74 72 69 78 20 22 32 3a  neral-matrix "2:
6000: 31 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20  1" *toppath*).  
6010: 20 20 3b 3b 20 4d 65 67 61 74 65 73 74 20 76 65    ;; Megatest ve
6020: 72 73 69 6f 6e 0a 20 20 20 20 28 69 75 70 3a 61  rsion.    (iup:a
6030: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 67 65  ttribute-set! ge
6040: 6e 65 72 61 6c 2d 6d 61 74 72 69 78 20 22 32 3a  neral-matrix "2:
6050: 30 22 20 22 56 65 72 73 69 6f 6e 22 29 0a 20 20  0" "Version").  
6060: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65    (iup:attribute
6070: 2d 73 65 74 21 20 67 65 6e 65 72 61 6c 2d 6d 61  -set! general-ma
6080: 74 72 69 78 20 22 32 3a 31 22 20 28 63 6f 6e 63  trix "2:1" (conc
6090: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f   megatest-versio
60a0: 6e 20 22 2d 22 20 28 73 75 62 73 74 72 69 6e 67  n "-" (substring
60b0: 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c   megatest-fossil
60c0: 2d 68 61 73 68 20 30 20 34 29 29 29 0a 0a 20 20  -hash 0 4)))..  
60d0: 20 20 67 65 6e 65 72 61 6c 2d 6d 61 74 72 69 78    general-matrix
60e0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 6f  ))..(define (dco
60f0: 6d 6d 6f 6e 3a 72 75 6e 2d 73 74 61 74 73 20 63  mmon:run-stats c
6100: 6f 6d 6d 6f 6e 64 61 74 20 74 61 62 64 61 74 20  ommondat tabdat 
6110: 23 21 6b 65 79 20 28 74 61 62 2d 6e 75 6d 20 23  #!key (tab-num #
6120: 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74  f)).  (let* ((st
6130: 61 74 73 2d 6d 61 74 72 69 78 20 28 69 75 70 3a  ats-matrix (iup:
6140: 6d 61 74 72 69 78 20 65 78 70 61 6e 64 3a 20 22  matrix expand: "
6150: 59 45 53 22 29 29 0a 09 20 28 63 68 61 6e 67 65  YES")).. (change
6160: 64 20 20 20 20 20 20 23 66 29 0a 09 20 28 73 74  d      #f).. (st
6170: 61 74 73 2d 75 70 64 61 74 65 72 20 28 6c 61 6d  ats-updater (lam
6180: 62 64 61 20 28 29 0a 09 09 09 20 28 69 66 20 28  bda ().... (if (
6190: 64 61 73 68 62 6f 61 72 64 3a 64 61 74 61 62 61  dashboard:databa
61a0: 73 65 2d 63 68 61 6e 67 65 64 3f 20 63 6f 6d 6d  se-changed? comm
61b0: 6f 6e 64 61 74 20 74 61 62 64 61 74 20 63 6f 6e  ondat tabdat con
61c0: 74 65 78 74 2d 6b 65 79 3a 20 27 72 75 6e 2d 73  text-key: 'run-s
61d0: 74 61 74 73 29 0a 09 09 09 20 20 20 20 20 28 6c  tats)....     (l
61e0: 65 74 2a 20 28 28 72 75 6e 2d 73 74 61 74 73 20  et* ((run-stats 
61f0: 20 20 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d     (rmt:get-run-
6200: 73 74 61 74 73 29 29 0a 09 09 09 09 20 20 20 20  stats)).....    
6210: 28 69 6e 64 69 63 65 73 20 20 20 20 20 20 28 63  (indices      (c
6220: 6f 6d 6d 6f 6e 3a 73 70 61 72 73 65 2d 6c 69 73  ommon:sparse-lis
6230: 74 2d 67 65 6e 65 72 61 74 65 2d 69 6e 64 65 78  t-generate-index
6240: 20 72 75 6e 2d 73 74 61 74 73 29 29 20 3b 3b 20   run-stats)) ;; 
6250: 20 70 72 6f 63 3a 20 73 65 74 2d 63 65 6c 6c 29   proc: set-cell)
6260: 29 0a 09 09 09 09 20 20 20 20 28 72 6f 77 2d 69  ).....    (row-i
6270: 6e 64 69 63 65 73 20 20 28 63 61 72 20 69 6e 64  ndices  (car ind
6280: 69 63 65 73 29 29 0a 09 09 09 09 20 20 20 20 28  ices)).....    (
6290: 63 6f 6c 2d 69 6e 64 69 63 65 73 20 20 28 63 61  col-indices  (ca
62a0: 64 72 20 69 6e 64 69 63 65 73 29 29 0a 09 09 09  dr indices))....
62b0: 09 20 20 20 20 28 6d 61 78 2d 72 6f 77 20 20 20  .    (max-row   
62c0: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 6f     (if (null? ro
62d0: 77 2d 69 6e 64 69 63 65 73 29 20 31 20 28 63 6f  w-indices) 1 (co
62e0: 6d 6d 6f 6e 3a 6d 61 78 20 28 6d 61 70 20 63 61  mmon:max (map ca
62f0: 64 72 20 72 6f 77 2d 69 6e 64 69 63 65 73 29 29  dr row-indices))
6300: 29 29 0a 09 09 09 09 20 20 20 20 28 6d 61 78 2d  )).....    (max-
6310: 63 6f 6c 20 20 20 20 20 20 28 69 66 20 28 6e 75  col      (if (nu
6320: 6c 6c 3f 20 63 6f 6c 2d 69 6e 64 69 63 65 73 29  ll? col-indices)
6330: 20 31 20 0a 09 09 09 09 09 09 20 20 20 20 20 20   1 .......      
6340: 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 20 28 6d 61 70  (common:max (map
6350: 20 63 61 64 72 20 63 6f 6c 2d 69 6e 64 69 63 65   cadr col-indice
6360: 73 29 29 29 29 0a 09 09 09 09 20 20 20 20 28 6d  s)))).....    (m
6370: 61 78 2d 76 69 73 69 62 6c 65 20 20 28 6d 61 78  ax-visible  (max
6380: 20 28 2d 20 28 64 62 6f 61 72 64 3a 74 61 62 64   (- (dboard:tabd
6390: 61 74 2d 6e 75 6d 2d 74 65 73 74 73 20 74 61 62  at-num-tests tab
63a0: 64 61 74 29 20 31 35 29 20 33 29 29 0a 09 09 09  dat) 15) 3))....
63b0: 09 20 20 20 20 28 6d 61 78 2d 63 6f 6c 2d 76 69  .    (max-col-vi
63c0: 73 20 20 28 69 66 20 28 3e 20 6d 61 78 2d 63 6f  s  (if (> max-co
63d0: 6c 20 31 30 29 20 31 30 20 6d 61 78 2d 63 6f 6c  l 10) 10 max-col
63e0: 29 29 0a 09 09 09 09 20 20 20 20 28 6e 75 6d 72  )).....    (numr
63f0: 6f 77 73 20 20 20 20 20 20 31 29 0a 09 09 09 09  ows      1).....
6400: 20 20 20 20 28 6e 75 6d 63 6f 6c 73 20 20 20 20      (numcols    
6410: 20 20 31 29 29 0a 09 09 09 20 20 20 20 20 20 20    1))....       
6420: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73  (iup:attribute-s
6430: 65 74 21 20 73 74 61 74 73 2d 6d 61 74 72 69 78  et! stats-matrix
6440: 20 22 43 4c 45 41 52 56 41 4c 55 45 22 20 22 43   "CLEARVALUE" "C
6450: 4f 4e 54 45 4e 54 53 22 29 0a 09 09 09 20 20 20  ONTENTS")....   
6460: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75      (iup:attribu
6470: 74 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d 61  te-set! stats-ma
6480: 74 72 69 78 20 22 4e 55 4d 43 4f 4c 22 20 6d 61  trix "NUMCOL" ma
6490: 78 2d 63 6f 6c 20 29 0a 09 09 09 20 20 20 20 20  x-col )....     
64a0: 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65    (iup:attribute
64b0: 2d 73 65 74 21 20 73 74 61 74 73 2d 6d 61 74 72  -set! stats-matr
64c0: 69 78 20 22 4e 55 4d 4c 49 4e 22 20 28 69 66 20  ix "NUMLIN" (if 
64d0: 28 3c 20 6d 61 78 2d 72 6f 77 20 6d 61 78 2d 76  (< max-row max-v
64e0: 69 73 69 62 6c 65 29 20 6d 61 78 2d 76 69 73 69  isible) max-visi
64f0: 62 6c 65 20 6d 61 78 2d 72 6f 77 29 29 20 3b 3b  ble max-row)) ;;
6500: 20 6d 69 6e 20 6f 66 20 32 30 0a 09 09 09 20 20   min of 20....  
6510: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62       (iup:attrib
6520: 75 74 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d  ute-set! stats-m
6530: 61 74 72 69 78 20 22 4e 55 4d 43 4f 4c 5f 56 49  atrix "NUMCOL_VI
6540: 53 49 42 4c 45 22 20 6d 61 78 2d 63 6f 6c 2d 76  SIBLE" max-col-v
6550: 69 73 29 0a 09 09 09 20 20 20 20 20 20 20 28 69  is)....       (i
6560: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74  up:attribute-set
6570: 21 20 73 74 61 74 73 2d 6d 61 74 72 69 78 20 22  ! stats-matrix "
6580: 4e 55 4d 4c 49 4e 5f 56 49 53 49 42 4c 45 22 20  NUMLIN_VISIBLE" 
6590: 28 69 66 20 28 3e 20 6d 61 78 2d 72 6f 77 20 6d  (if (> max-row m
65a0: 61 78 2d 76 69 73 69 62 6c 65 29 20 6d 61 78 2d  ax-visible) max-
65b0: 76 69 73 69 62 6c 65 20 6d 61 78 2d 72 6f 77 29  visible max-row)
65c0: 29 0a 0a 09 09 09 20 20 20 20 20 20 20 3b 3b 20  ).....       ;; 
65d0: 52 6f 77 20 6c 61 62 65 6c 73 0a 09 09 09 20 20  Row labels....  
65e0: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28       (for-each (
65f0: 6c 61 6d 62 64 61 20 28 69 6e 64 29 0a 09 09 09  lambda (ind)....
6600: 09 09 20 20 20 28 6c 65 74 2a 20 28 28 6e 61 6d  ..   (let* ((nam
6610: 65 20 28 63 61 72 20 69 6e 64 29 29 0a 09 09 09  e (car ind))....
6620: 09 09 09 20 20 28 6e 75 6d 20 20 28 63 61 64 72  ...  (num  (cadr
6630: 20 69 6e 64 29 29 0a 09 09 09 09 09 09 20 20 28   ind)).......  (
6640: 6b 65 79 20 20 28 63 6f 6e 63 20 6e 75 6d 20 22  key  (conc num "
6650: 3a 30 22 29 29 29 0a 09 09 09 09 09 20 20 20 20  :0")))......    
6660: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c   (if (not (equal
6670: 3f 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65  ? (iup:attribute
6680: 20 73 74 61 74 73 2d 6d 61 74 72 69 78 20 6b 65   stats-matrix ke
6690: 79 29 20 6e 61 6d 65 29 29 0a 09 09 09 09 09 09  y) name)).......
66a0: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20   (begin.......  
66b0: 20 28 73 65 74 21 20 63 68 61 6e 67 65 64 20 23   (set! changed #
66c0: 74 29 0a 09 09 09 09 09 09 20 20 20 28 69 75 70  t).......   (iup
66d0: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20  :attribute-set! 
66e0: 73 74 61 74 73 2d 6d 61 74 72 69 78 20 6b 65 79  stats-matrix key
66f0: 20 6e 61 6d 65 29 29 29 29 29 0a 09 09 09 09 09   name)))))......
6700: 20 72 6f 77 2d 69 6e 64 69 63 65 73 29 0a 0a 09   row-indices)...
6710: 09 09 20 20 20 20 20 20 20 3b 3b 20 43 6f 6c 20  ..       ;; Col 
6720: 6c 61 62 65 6c 73 0a 09 09 09 20 20 20 20 20 20  labels....      
6730: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62   (for-each (lamb
6740: 64 61 20 28 69 6e 64 29 0a 09 09 09 09 09 20 20  da (ind)......  
6750: 20 28 6c 65 74 2a 20 28 28 6e 61 6d 65 20 28 63   (let* ((name (c
6760: 61 72 20 69 6e 64 29 29 0a 09 09 09 09 09 09 20  ar ind))....... 
6770: 20 28 6e 75 6d 20 20 28 63 61 64 72 20 69 6e 64   (num  (cadr ind
6780: 29 29 0a 09 09 09 09 09 09 20 20 28 6b 65 79 20  )).......  (key 
6790: 20 28 63 6f 6e 63 20 22 30 3a 22 20 6e 75 6d 29   (conc "0:" num)
67a0: 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66  ))......     (if
67b0: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 69   (not (equal? (i
67c0: 75 70 3a 61 74 74 72 69 62 75 74 65 20 73 74 61  up:attribute sta
67d0: 74 73 2d 6d 61 74 72 69 78 20 6b 65 79 29 20 6e  ts-matrix key) n
67e0: 61 6d 65 29 29 0a 09 09 09 09 09 09 20 28 62 65  ame))....... (be
67f0: 67 69 6e 0a 09 09 09 09 09 09 20 20 20 28 73 65  gin.......   (se
6800: 74 21 20 63 68 61 6e 67 65 64 20 23 74 29 0a 09  t! changed #t)..
6810: 09 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 74  .....   (iup:att
6820: 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 61 74  ribute-set! stat
6830: 73 2d 6d 61 74 72 69 78 20 6b 65 79 20 6e 61 6d  s-matrix key nam
6840: 65 29 29 29 29 29 0a 09 09 09 09 09 20 63 6f 6c  e)))))...... col
6850: 2d 69 6e 64 69 63 65 73 29 0a 0a 09 09 09 20 20  -indices).....  
6860: 20 20 20 20 20 3b 3b 20 43 65 6c 6c 20 63 6f 6e       ;; Cell con
6870: 74 65 6e 74 73 0a 09 09 09 20 20 20 20 20 20 20  tents....       
6880: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64  (for-each (lambd
6890: 61 20 28 65 6e 74 72 79 29 0a 09 09 09 09 09 20  a (entry)...... 
68a0: 20 20 28 6c 65 74 2a 20 28 28 72 6f 77 2d 6e 61    (let* ((row-na
68b0: 6d 65 20 28 63 61 72 20 65 6e 74 72 79 29 29 0a  me (car entry)).
68c0: 09 09 09 09 09 09 20 20 28 63 6f 6c 2d 6e 61 6d  ......  (col-nam
68d0: 65 20 28 63 61 64 72 20 65 6e 74 72 79 29 29 0a  e (cadr entry)).
68e0: 09 09 09 09 09 09 20 20 28 76 61 6c 75 65 20 20  ......  (value  
68f0: 20 20 28 63 61 64 64 72 20 65 6e 74 72 79 29 29    (caddr entry))
6900: 0a 09 09 09 09 09 09 20 20 28 72 6f 77 2d 6e 75  .......  (row-nu
6910: 6d 20 20 28 63 61 64 72 20 28 61 73 73 6f 63 20  m  (cadr (assoc 
6920: 72 6f 77 2d 6e 61 6d 65 20 72 6f 77 2d 69 6e 64  row-name row-ind
6930: 69 63 65 73 29 29 29 0a 09 09 09 09 09 09 20 20  ices))).......  
6940: 28 63 6f 6c 2d 6e 75 6d 20 20 28 63 61 64 72 20  (col-num  (cadr 
6950: 28 61 73 73 6f 63 20 63 6f 6c 2d 6e 61 6d 65 20  (assoc col-name 
6960: 63 6f 6c 2d 69 6e 64 69 63 65 73 29 29 29 0a 09  col-indices)))..
6970: 09 09 09 09 09 20 20 28 6b 65 79 20 20 20 20 20  .....  (key     
6980: 20 28 63 6f 6e 63 20 72 6f 77 2d 6e 75 6d 20 22   (conc row-num "
6990: 3a 22 20 63 6f 6c 2d 6e 75 6d 29 29 29 0a 09 09  :" col-num)))...
69a0: 09 09 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74  ...     (if (not
69b0: 20 28 65 71 75 61 6c 3f 20 28 69 75 70 3a 61 74   (equal? (iup:at
69c0: 74 72 69 62 75 74 65 20 73 74 61 74 73 2d 6d 61  tribute stats-ma
69d0: 74 72 69 78 20 6b 65 79 29 20 76 61 6c 75 65 29  trix key) value)
69e0: 29 0a 09 09 09 09 09 09 20 28 62 65 67 69 6e 0a  )....... (begin.
69f0: 09 09 09 09 09 09 20 20 20 28 73 65 74 21 20 63  ......   (set! c
6a00: 68 61 6e 67 65 64 20 23 74 29 0a 09 09 09 09 09  hanged #t)......
6a10: 09 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75  .   (iup:attribu
6a20: 74 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d 61  te-set! stats-ma
6a30: 74 72 69 78 20 6b 65 79 20 76 61 6c 75 65 29 29  trix key value))
6a40: 29 29 29 0a 09 09 09 09 09 20 72 75 6e 2d 73 74  )))...... run-st
6a50: 61 74 73 29 0a 09 09 09 20 20 20 20 20 20 20 28  ats)....       (
6a60: 69 66 20 63 68 61 6e 67 65 64 20 28 69 75 70 3a  if changed (iup:
6a70: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73  attribute-set! s
6a80: 74 61 74 73 2d 6d 61 74 72 69 78 20 22 52 45 44  tats-matrix "RED
6a90: 52 41 57 22 20 22 41 4c 4c 22 29 29 29 0a 20 20  RAW" "ALL"))).  
6aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
6ab0: 20 20 20 20 20 20 20 20 20 20 20 29 29 29 29 0a             )))).
6ac0: 20 20 20 20 3b 3b 20 28 64 62 6f 61 72 64 3a 63      ;; (dboard:c
6ad0: 6f 6d 6d 6f 6e 64 61 74 2d 70 6c 65 61 73 65 2d  ommondat-please-
6ae0: 75 70 64 61 74 65 2d 73 65 74 21 20 63 6f 6d 6d  update-set! comm
6af0: 6f 6e 64 61 74 20 23 74 29 20 3b 3b 20 66 6f 72  ondat #t) ;; for
6b00: 63 65 20 72 65 64 72 61 77 20 6f 6e 20 66 69 72  ce redraw on fir
6b10: 73 74 20 70 61 73 73 20 0a 20 20 20 20 3b 3b 20  st pass .    ;; 
6b20: 28 6d 61 72 6b 2d 66 6f 72 2d 75 70 64 61 74 65  (mark-for-update
6b30: 20 74 61 62 64 61 74 29 0a 20 20 20 20 3b 3b 20   tabdat).    ;; 
6b40: 28 73 74 61 74 73 2d 75 70 64 61 74 65 72 29 0a  (stats-updater).
6b50: 20 20 20 20 28 64 62 6f 61 72 64 3a 63 6f 6d 6d      (dboard:comm
6b60: 6f 6e 64 61 74 2d 61 64 64 2d 75 70 64 61 74 65  ondat-add-update
6b70: 72 20 63 6f 6d 6d 6f 6e 64 61 74 20 73 74 61 74  r commondat stat
6b80: 73 2d 75 70 64 61 74 65 72 20 74 61 62 2d 6e 75  s-updater tab-nu
6b90: 6d 3a 20 74 61 62 2d 6e 75 6d 29 0a 20 20 20 20  m: tab-num).    
6ba0: 3b 3b 20 28 73 65 74 21 20 64 61 73 68 62 6f 61  ;; (set! dashboa
6bb0: 72 64 3a 75 70 64 61 74 65 2d 73 75 6d 6d 61 72  rd:update-summar
6bc0: 79 2d 74 61 62 20 75 70 64 61 74 65 72 29 0a 20  y-tab updater). 
6bd0: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74     (iup:attribut
6be0: 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d 61 74  e-set! stats-mat
6bf0: 72 69 78 20 22 57 49 44 54 48 44 45 46 22 20 22  rix "WIDTHDEF" "
6c00: 34 30 22 29 0a 20 20 20 20 28 69 75 70 3a 76 62  40").    (iup:vb
6c10: 6f 78 0a 20 20 20 20 20 3b 3b 20 28 69 75 70 3a  ox.     ;; (iup:
6c20: 6c 61 62 65 6c 20 22 52 75 6e 20 73 74 61 74 69  label "Run stati
6c30: 73 74 69 63 73 22 20 20 23 3a 65 78 70 61 6e 64  stics"  #:expand
6c40: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 29 0a 20   "HORIZONTAL"). 
6c50: 20 20 20 20 73 74 61 74 73 2d 6d 61 74 72 69 78      stats-matrix
6c60: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63  )))..(define (dc
6c70: 6f 6d 6d 6f 6e 3a 73 65 72 76 65 72 73 2d 74 61  ommon:servers-ta
6c80: 62 6c 65 20 63 6f 6d 6d 6f 6e 64 61 74 20 74 61  ble commondat ta
6c90: 62 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28  bdat).  (let* ((
6ca0: 63 6f 6c 6e 75 6d 20 20 20 20 20 20 20 20 20 30  colnum         0
6cb0: 29 0a 09 20 28 72 6f 77 6e 75 6d 20 20 20 20 20  ).. (rownum     
6cc0: 20 20 20 20 30 29 0a 09 20 28 73 65 72 76 65 72      0).. (server
6cd0: 73 2d 6d 61 74 72 69 78 20 28 69 75 70 3a 6d 61  s-matrix (iup:ma
6ce0: 74 72 69 78 20 23 3a 65 78 70 61 6e 64 20 22 59  trix #:expand "Y
6cf0: 45 53 22 0a 09 09 09 09 20 20 20 20 20 23 3a 6e  ES".....     #:n
6d00: 75 6d 63 6f 6c 20 37 0a 09 09 09 09 20 20 20 20  umcol 7.....    
6d10: 20 23 3a 6e 75 6d 63 6f 6c 2d 76 69 73 69 62 6c   #:numcol-visibl
6d20: 65 20 37 0a 09 09 09 09 20 20 20 20 20 23 3a 6e  e 7.....     #:n
6d30: 75 6d 6c 69 6e 2d 76 69 73 69 62 6c 65 20 35 0a  umlin-visible 5.
6d40: 09 09 09 09 20 20 20 20 20 29 29 0a 09 20 28 63  ....     )).. (c
6d50: 6f 6c 6e 61 6d 65 73 20 20 20 20 20 20 20 28 6c  olnames       (l
6d60: 69 73 74 20 22 49 64 22 20 22 4d 54 76 65 72 22  ist "Id" "MTver"
6d70: 20 22 50 69 64 22 20 22 48 6f 73 74 22 20 22 49   "Pid" "Host" "I
6d80: 6e 74 65 72 66 61 63 65 3a 4f 75 74 50 6f 72 74  nterface:OutPort
6d90: 22 20 22 52 75 6e 54 69 6d 65 22 20 22 53 74 61  " "RunTime" "Sta
6da0: 74 65 22 20 22 52 75 6e 49 64 22 29 29 0a 09 20  te" "RunId")).. 
6db0: 28 75 70 64 61 74 65 72 20 20 20 20 20 20 20 20  (updater        
6dc0: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20  (lambda ()....  
6dd0: 20 28 69 66 20 28 64 61 73 68 62 6f 61 72 64 3a   (if (dashboard:
6de0: 6d 6f 6e 69 74 6f 72 2d 63 68 61 6e 67 65 64 3f  monitor-changed?
6df0: 20 63 6f 6d 6d 6f 6e 64 61 74 20 74 61 62 64 61   commondat tabda
6e00: 74 29 0a 09 09 09 20 20 20 20 20 20 20 28 6c 65  t)....       (le
6e10: 74 20 28 28 73 65 72 76 65 72 73 20 20 28 73 65  t ((servers  (se
6e20: 72 76 65 72 3a 67 65 74 2d 6c 69 73 74 20 2a 74  rver:get-list *t
6e30: 6f 70 70 61 74 68 2a 20 6c 69 6d 69 74 3a 20 31  oppath* limit: 1
6e40: 30 29 29 29 0a 09 09 09 09 20 28 69 75 70 3a 61  0)))..... (iup:a
6e50: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 65  ttribute-set! se
6e60: 72 76 65 72 73 2d 6d 61 74 72 69 78 20 22 4e 55  rvers-matrix "NU
6e70: 4d 4c 49 4e 22 20 28 6c 65 6e 67 74 68 20 73 65  MLIN" (length se
6e80: 72 76 65 72 73 29 29 0a 09 09 09 09 20 3b 3b 20  rvers))..... ;; 
6e90: 28 73 65 74 21 20 63 6f 6c 6e 75 6d 20 30 29 0a  (set! colnum 0).
6ea0: 09 09 09 09 20 3b 3b 20 28 66 6f 72 2d 65 61 63  .... ;; (for-eac
6eb0: 68 20 28 6c 61 6d 62 64 61 20 28 63 6f 6c 6e 61  h (lambda (colna
6ec0: 6d 65 29 0a 09 09 09 09 20 3b 3b 20 20 20 20 09  me)..... ;;    .
6ed0: 20 3b 3b 20 28 70 72 69 6e 74 20 22 63 6f 6c 6e   ;; (print "coln
6ee0: 75 6d 3a 20 22 20 63 6f 6c 6e 75 6d 20 22 20 63  um: " colnum " c
6ef0: 6f 6c 6e 61 6d 65 3a 20 22 20 63 6f 6c 6e 61 6d  olname: " colnam
6f00: 65 29 0a 09 09 09 09 20 3b 3b 20 20 20 20 09 20  e)..... ;;    . 
6f10: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73  (iup:attribute-s
6f20: 65 74 21 20 73 65 72 76 65 72 73 2d 6d 61 74 72  et! servers-matr
6f30: 69 78 20 28 63 6f 6e 63 20 22 30 3a 22 20 63 6f  ix (conc "0:" co
6f40: 6c 6e 75 6d 29 20 63 6f 6c 6e 61 6d 65 29 0a 09  lnum) colname)..
6f50: 09 09 09 20 3b 3b 20 20 20 20 09 20 28 73 65 74  ... ;;    . (set
6f60: 21 20 63 6f 6c 6e 75 6d 20 28 2b 20 31 20 63 6f  ! colnum (+ 1 co
6f70: 6c 6e 75 6d 29 29 29 0a 09 09 09 09 20 3b 3b 20  lnum)))..... ;; 
6f80: 20 20 20 20 20 20 20 20 20 20 63 6f 6c 6e 61 6d            colnam
6f90: 65 73 29 0a 09 09 09 09 20 28 73 65 74 21 20 72  es)..... (set! r
6fa0: 6f 77 6e 75 6d 20 31 29 0a 09 09 09 09 20 28 66  ownum 1)..... (f
6fb0: 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 20 20 28  or-each .....  (
6fc0: 6c 61 6d 62 64 61 20 28 73 65 72 76 65 72 29 0a  lambda (server).
6fd0: 09 09 09 09 20 20 20 20 28 73 65 74 21 20 63 6f  ....    (set! co
6fe0: 6c 6e 75 6d 20 30 29 0a 09 09 09 09 20 20 20 20  lnum 0).....    
6ff0: 28 6d 61 74 63 68 2d 6c 65 74 20 28 28 28 6d 6f  (match-let (((mo
7000: 64 2d 74 69 6d 65 20 68 6f 73 74 20 70 6f 72 74  d-time host port
7010: 20 73 74 61 72 74 2d 74 69 6d 65 20 70 69 64 29   start-time pid)
7020: 0a 09 09 09 09 09 09 20 73 65 72 76 65 72 29 29  ....... server))
7030: 0a 09 09 09 09 20 20 20 20 20 20 28 6c 65 74 2a  .....      (let*
7040: 20 28 28 75 70 74 69 6d 65 20 20 28 2d 20 28 63   ((uptime  (- (c
7050: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20  urrent-seconds) 
7060: 6d 6f 64 2d 74 69 6d 65 29 29 0a 09 09 09 09 09  mod-time))......
7070: 20 20 20 20 20 28 72 75 6e 74 69 6d 65 20 28 69       (runtime (i
7080: 66 20 73 74 61 72 74 2d 74 69 6d 65 0a 09 09 09  f start-time....
7090: 09 09 09 09 20 20 28 2d 20 6d 6f 64 2d 74 69 6d  ....  (- mod-tim
70a0: 65 20 73 74 61 72 74 2d 74 69 6d 65 29 0a 09 09  e start-time)...
70b0: 09 09 09 09 09 20 20 30 29 29 0a 09 09 09 09 09  .....  0))......
70c0: 20 20 20 20 20 28 76 61 6c 73 20 28 6c 69 73 74       (vals (list
70d0: 20 22 2d 22 20 20 3b 3b 20 28 76 65 63 74 6f 72   "-"  ;; (vector
70e0: 2d 72 65 66 20 73 65 72 76 65 72 20 30 29 20 3b  -ref server 0) ;
70f0: 3b 20 49 64 0a 09 09 09 09 09 09 09 20 22 2d 22  ; Id........ "-"
7100: 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66    ;; (vector-ref
7110: 20 73 65 72 76 65 72 20 39 29 20 3b 3b 20 4d 54   server 9) ;; MT
7120: 2d 56 65 72 0a 09 09 09 09 09 09 09 20 70 69 64  -Ver........ pid
7130: 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66    ;; (vector-ref
7140: 20 73 65 72 76 65 72 20 31 29 20 3b 3b 20 50 69   server 1) ;; Pi
7150: 64 0a 09 09 09 09 09 09 09 20 68 6f 73 74 20 3b  d........ host ;
7160: 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65  ; (vector-ref se
7170: 72 76 65 72 20 32 29 20 3b 3b 20 48 6f 73 74 6e  rver 2) ;; Hostn
7180: 61 6d 65 0a 09 09 09 09 09 09 09 20 28 63 6f 6e  ame........ (con
7190: 63 20 68 6f 73 74 20 22 3a 22 20 70 6f 72 74 29  c host ":" port)
71a0: 20 3b 3b 20 28 63 6f 6e 63 20 28 76 65 63 74 6f   ;; (conc (vecto
71b0: 72 2d 72 65 66 20 73 65 72 76 65 72 20 33 29 20  r-ref server 3) 
71c0: 22 3a 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20  ":" (vector-ref 
71d0: 73 65 72 76 65 72 20 34 29 29 20 3b 3b 20 49 50  server 4)) ;; IP
71e0: 3a 50 6f 72 74 0a 09 09 09 09 09 09 09 20 28 73  :Port........ (s
71f0: 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e 2d 73  econds->hr-min-s
7200: 65 63 20 72 75 6e 74 69 6d 65 29 20 3b 3b 20 28  ec runtime) ;; (
7210: 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e  - (current-secon
7220: 64 73 29 20 73 74 61 72 74 2d 74 69 6d 65 29 29  ds) start-time))
7230: 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20   ;; (vector-ref 
7240: 73 65 72 76 65 72 20 36 29 29 29 0a 09 09 09 09  server 6))).....
7250: 09 09 09 20 28 63 6f 6e 64 0a 09 09 09 09 09 09  ... (cond.......
7260: 09 20 20 28 28 3c 20 75 70 74 69 6d 65 20 35 29  .  ((< uptime 5)
7270: 20 20 22 61 6c 69 76 65 22 29 0a 09 09 09 09 09    "alive")......
7280: 09 09 20 20 28 28 3c 20 75 70 74 69 6d 65 20 31  ..  ((< uptime 1
7290: 36 29 20 22 70 72 6f 62 61 62 6c 79 20 61 6c 69  6) "probably ali
72a0: 76 65 22 29 3b 3b 20 6c 65 73 73 20 74 68 61 6e  ve");; less than
72b0: 20 31 35 20 73 65 63 6f 6e 64 73 20 73 69 6e 63   15 seconds sinc
72c0: 65 20 6d 6f 64 2c 20 63 61 6c 6c 20 69 74 20 61  e mod, call it a
72d0: 6c 69 76 65 20 28 76 65 63 74 6f 72 2d 72 65 66  live (vector-ref
72e0: 20 73 65 72 76 65 72 20 38 29 20 3b 3b 20 53 74   server 8) ;; St
72f0: 61 74 65 0a 09 09 09 09 09 09 09 20 20 28 65 6c  ate........  (el
7300: 73 65 20 22 64 65 61 64 22 29 29 0a 09 09 09 09  se "dead")).....
7310: 09 09 09 20 22 2d 22 20 3b 3b 20 28 76 65 63 74  ... "-" ;; (vect
7320: 6f 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 32  or-ref server 12
7330: 29 20 20 3b 3b 20 52 75 6e 49 64 0a 09 09 09 09  )  ;; RunId.....
7340: 09 09 09 20 29 29 29 0a 09 09 09 09 09 28 66 6f  ... )))......(fo
7350: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28  r-each (lambda (
7360: 76 61 6c 29 0a 09 09 09 09 09 09 20 20 20 20 28  val).......    (
7370: 6c 65 74 2a 20 28 28 72 6f 77 2d 63 6f 6c 20 28  let* ((row-col (
7380: 63 6f 6e 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20  conc rownum ":" 
7390: 63 6f 6c 6e 75 6d 29 29 0a 09 09 09 09 09 09 09  colnum))........
73a0: 20 20 20 28 63 75 72 72 2d 76 61 6c 20 28 69 75     (curr-val (iu
73b0: 70 3a 61 74 74 72 69 62 75 74 65 20 73 65 72 76  p:attribute serv
73c0: 65 72 73 2d 6d 61 74 72 69 78 20 72 6f 77 2d 63  ers-matrix row-c
73d0: 6f 6c 29 29 29 0a 09 09 09 09 09 09 20 20 20 20  ol))).......    
73e0: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61    (if (not (equa
73f0: 6c 3f 20 28 63 6f 6e 63 20 76 61 6c 29 20 63 75  l? (conc val) cu
7400: 72 72 2d 76 61 6c 29 29 0a 09 09 09 09 09 09 09  rr-val))........
7410: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09    (begin........
7420: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75      (iup:attribu
7430: 74 65 2d 73 65 74 21 20 73 65 72 76 65 72 73 2d  te-set! servers-
7440: 6d 61 74 72 69 78 20 72 6f 77 2d 63 6f 6c 20 76  matrix row-col v
7450: 61 6c 29 0a 09 09 09 09 09 09 09 20 20 20 20 28  al)........    (
7460: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65  iup:attribute-se
7470: 74 21 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69  t! servers-matri
7480: 78 20 22 46 49 54 54 4f 54 45 58 54 22 20 28 63  x "FITTOTEXT" (c
7490: 6f 6e 63 20 22 43 22 20 63 6f 6c 6e 75 6d 29 29  onc "C" colnum))
74a0: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28  )).......      (
74b0: 73 65 74 21 20 63 6f 6c 6e 75 6d 20 28 2b 20 31  set! colnum (+ 1
74c0: 20 63 6f 6c 6e 75 6d 29 29 29 29 0a 09 09 09 09   colnum)))).....
74d0: 09 09 20 20 76 61 6c 73 29 0a 09 09 09 09 09 28  ..  vals)......(
74e0: 73 65 74 21 20 72 6f 77 6e 75 6d 20 28 2b 20 72  set! rownum (+ r
74f0: 6f 77 6e 75 6d 20 31 29 29 29 0a 09 09 09 09 20  ownum 1)))..... 
7500: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62       (iup:attrib
7510: 75 74 65 2d 73 65 74 21 20 73 65 72 76 65 72 73  ute-set! servers
7520: 2d 6d 61 74 72 69 78 20 22 52 45 44 52 41 57 22  -matrix "REDRAW"
7530: 20 22 41 4c 4c 22 29 29 29 0a 09 09 09 09 20 20   "ALL"))).....  
7540: 20 20 28 73 6f 72 74 20 73 65 72 76 65 72 73 20    (sort servers 
7550: 28 6c 61 6d 62 64 61 20 28 61 20 62 29 28 3e 20  (lambda (a b)(> 
7560: 28 63 61 72 20 61 29 28 63 61 72 20 62 29 29 29  (car a)(car b)))
7570: 29 29 29 29 29 29 29 0a 20 20 20 20 28 73 65 74  ))))))).    (set
7580: 21 20 63 6f 6c 6e 75 6d 20 30 29 0a 20 20 20 20  ! colnum 0).    
7590: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64  (for-each (lambd
75a0: 61 20 28 63 6f 6c 6e 61 6d 65 29 0a 09 09 28 69  a (colname)...(i
75b0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74  up:attribute-set
75c0: 21 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69 78  ! servers-matrix
75d0: 20 28 63 6f 6e 63 20 22 30 3a 22 20 63 6f 6c 6e   (conc "0:" coln
75e0: 75 6d 29 20 63 6f 6c 6e 61 6d 65 29 0a 09 09 28  um) colname)...(
75f0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65  iup:attribute-se
7600: 74 21 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69  t! servers-matri
7610: 78 20 22 46 49 54 54 4f 54 45 58 54 22 20 28 63  x "FITTOTEXT" (c
7620: 6f 6e 63 20 22 43 22 20 63 6f 6c 6e 75 6d 29 29  onc "C" colnum))
7630: 0a 09 09 28 73 65 74 21 20 63 6f 6c 6e 75 6d 20  ...(set! colnum 
7640: 28 2b 20 63 6f 6c 6e 75 6d 20 31 29 29 29 0a 09  (+ colnum 1)))..
7650: 20 20 20 20 20 20 63 6f 6c 6e 61 6d 65 73 29 0a        colnames).
7660: 20 20 20 20 3b 3b 20 28 73 65 74 21 20 64 61 73      ;; (set! das
7670: 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 73 65  hboard:update-se
7680: 72 76 65 72 73 2d 74 61 62 6c 65 20 75 70 64 61  rvers-table upda
7690: 74 65 72 29 20 0a 20 20 20 20 28 64 62 6f 61 72  ter) .    (dboar
76a0: 64 3a 63 6f 6d 6d 6f 6e 64 61 74 2d 61 64 64 2d  d:commondat-add-
76b0: 75 70 64 61 74 65 72 20 63 6f 6d 6d 6f 6e 64 61  updater commonda
76c0: 74 20 75 70 64 61 74 65 72 29 0a 20 20 20 20 3b  t updater).    ;
76d0: 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65  ; (iup:attribute
76e0: 2d 73 65 74 21 20 73 65 72 76 65 72 73 2d 6d 61  -set! servers-ma
76f0: 74 72 69 78 20 22 57 49 44 54 48 44 45 46 22 20  trix "WIDTHDEF" 
7700: 22 34 30 22 29 0a 20 20 20 20 3b 3b 20 20 28 69  "40").    ;;  (i
7710: 75 70 3a 68 62 6f 78 0a 20 20 20 20 3b 3b 20 20  up:hbox.    ;;  
7720: 20 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 20 3b   (iup:vbox.    ;
7730: 3b 20 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e  ;    (iup:button
7740: 20 22 53 74 61 72 74 22 0a 20 20 20 20 3b 3b 20   "Start".    ;; 
7750: 20 20 20 20 20 09 20 20 3b 3b 20 23 3a 73 69 7a       .  ;; #:siz
7760: 65 20 22 35 30 78 22 0a 20 20 20 20 3b 3b 20 20  e "50x".    ;;  
7770: 20 20 20 20 09 20 20 23 3a 65 78 70 61 6e 64 20      .  #:expand 
7780: 22 59 45 53 22 0a 20 20 20 20 3b 3b 20 20 20 20  "YES".    ;;    
7790: 20 20 09 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c    .  #:action (l
77a0: 61 6d 62 64 61 20 28 6f 62 6a 29 0a 20 20 20 20  ambda (obj).    
77b0: 3b 3b 20 20 20 20 20 20 09 09 20 20 20 20 20 28  ;;      ..     (
77c0: 6c 65 74 20 28 28 63 6d 64 20 28 63 6f 6e 63 20  let ((cmd (conc 
77d0: 3b 3b 20 22 78 74 65 72 6d 20 2d 67 65 6f 6d 65  ;; "xterm -geome
77e0: 74 72 79 20 31 38 30 78 32 30 20 2d 65 20 5c 22  try 180x20 -e \"
77f0: 22 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09  ".    ;;      ..
7800: 09 09 20 20 20 20 20 20 22 6d 65 67 61 74 65 73  ..      "megates
7810: 74 20 2d 73 65 72 76 65 72 20 2d 20 26 22 29 29  t -server - &"))
7820: 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09  ).    ;;      ..
7830: 09 09 20 20 20 20 20 20 3b 3b 20 22 3b 65 63 68  ..      ;; ";ech
7840: 6f 20 50 72 65 73 73 20 61 6e 79 20 6b 65 79 20  o Press any key 
7850: 74 6f 20 63 6f 6e 74 69 6e 75 65 3b 62 61 73 68  to continue;bash
7860: 20 2d 63 20 27 72 65 61 64 20 2d 6e 20 31 20 2d   -c 'read -n 1 -
7870: 73 27 5c 22 20 26 22 29 29 29 0a 20 20 20 20 3b  s'\" &"))).    ;
7880: 3b 20 20 20 20 20 20 09 09 20 20 20 20 20 20 20  ;      ..       
7890: 28 73 79 73 74 65 6d 20 63 6d 64 29 29 29 29 0a  (system cmd)))).
78a0: 20 20 20 20 3b 3b 20 20 20 20 28 69 75 70 3a 62      ;;    (iup:b
78b0: 75 74 74 6f 6e 20 22 53 74 6f 70 22 0a 20 20 20  utton "Stop".   
78c0: 20 3b 3b 20 20 20 20 20 20 09 20 20 23 3a 65 78   ;;      .  #:ex
78d0: 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20 20 3b  pand "YES".    ;
78e0: 3b 20 20 20 20 20 20 09 20 20 3b 3b 20 23 3a 73  ;      .  ;; #:s
78f0: 69 7a 65 20 22 35 30 78 22 0a 20 20 20 20 3b 3b  ize "50x".    ;;
7900: 20 20 20 20 20 20 09 20 20 23 3a 61 63 74 69 6f        .  #:actio
7910: 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a  n (lambda (obj).
7920: 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09 20 20      ;;      ..  
7930: 20 20 20 28 6c 65 74 20 28 28 63 6d 64 20 28 63     (let ((cmd (c
7940: 6f 6e 63 20 3b 3b 20 22 78 74 65 72 6d 20 2d 67  onc ;; "xterm -g
7950: 65 6f 6d 65 74 72 79 20 31 38 30 78 32 30 20 2d  eometry 180x20 -
7960: 65 20 5c 22 22 0a 20 20 20 20 3b 3b 20 20 20 20  e \"".    ;;    
7970: 20 20 09 09 09 09 20 20 20 20 20 20 22 6d 65 67    ....      "meg
7980: 61 74 65 73 74 20 2d 73 74 6f 70 2d 73 65 72 76  atest -stop-serv
7990: 65 72 20 30 20 26 22 29 29 29 0a 20 20 20 20 3b  er 0 &"))).    ;
79a0: 3b 20 20 20 20 20 20 09 09 09 09 20 20 20 20 20  ;      ....     
79b0: 20 3b 3b 20 22 3b 65 63 68 6f 20 50 72 65 73 73   ;; ";echo Press
79c0: 20 61 6e 79 20 6b 65 79 20 74 6f 20 63 6f 6e 74   any key to cont
79d0: 69 6e 75 65 3b 62 61 73 68 20 2d 63 20 27 72 65  inue;bash -c 're
79e0: 61 64 20 2d 6e 20 31 20 2d 73 27 5c 22 20 26 22  ad -n 1 -s'\" &"
79f0: 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 20  ))).    ;;      
7a00: 09 09 20 20 20 20 20 20 20 28 73 79 73 74 65 6d  ..       (system
7a10: 20 63 6d 64 29 29 29 29 0a 20 20 20 20 3b 3b 20   cmd)))).    ;; 
7a20: 20 20 20 28 69 75 70 3a 62 75 74 74 6f 6e 20 22     (iup:button "
7a30: 52 65 73 74 61 72 74 22 0a 20 20 20 20 3b 3b 20  Restart".    ;; 
7a40: 20 20 20 20 20 09 20 20 23 3a 65 78 70 61 6e 64       .  #:expand
7a50: 20 22 59 45 53 22 0a 20 20 20 20 3b 3b 20 20 20   "YES".    ;;   
7a60: 20 20 20 09 20 20 3b 3b 20 23 3a 73 69 7a 65 20     .  ;; #:size 
7a70: 22 35 30 78 22 0a 20 20 20 20 3b 3b 20 20 20 20  "50x".    ;;    
7a80: 20 20 09 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c    .  #:action (l
7a90: 61 6d 62 64 61 20 28 6f 62 6a 29 0a 20 20 20 20  ambda (obj).    
7aa0: 3b 3b 20 20 20 20 20 20 09 09 20 20 20 20 20 28  ;;      ..     (
7ab0: 6c 65 74 20 28 28 63 6d 64 20 28 63 6f 6e 63 20  let ((cmd (conc 
7ac0: 3b 3b 20 22 78 74 65 72 6d 20 2d 67 65 6f 6d 65  ;; "xterm -geome
7ad0: 74 72 79 20 31 38 30 78 32 30 20 2d 65 20 5c 22  try 180x20 -e \"
7ae0: 22 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09  ".    ;;      ..
7af0: 09 09 20 20 20 20 20 20 22 6d 65 67 61 74 65 73  ..      "megates
7b00: 74 20 2d 73 74 6f 70 2d 73 65 72 76 65 72 20 30  t -stop-server 0
7b10: 3b 6d 65 67 61 74 65 73 74 20 2d 73 65 72 76 65  ;megatest -serve
7b20: 72 20 2d 20 26 22 29 29 29 0a 20 20 20 20 3b 3b  r - &"))).    ;;
7b30: 20 20 20 20 20 20 09 09 09 09 20 20 20 20 20 20        ....      
7b40: 3b 3b 20 22 3b 65 63 68 6f 20 50 72 65 73 73 20  ;; ";echo Press 
7b50: 61 6e 79 20 6b 65 79 20 74 6f 20 63 6f 6e 74 69  any key to conti
7b60: 6e 75 65 3b 62 61 73 68 20 2d 63 20 27 72 65 61  nue;bash -c 'rea
7b70: 64 20 2d 6e 20 31 20 2d 73 27 5c 22 20 26 22 29  d -n 1 -s'\" &")
7b80: 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09  )).    ;;      .
7b90: 09 20 20 20 20 20 20 20 28 73 79 73 74 65 6d 20  .       (system 
7ba0: 63 6d 64 29 29 29 29 29 0a 20 20 20 20 3b 3b 20  cmd))))).    ;; 
7bb0: 20 20 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69     servers-matri
7bc0: 78 0a 20 20 20 20 3b 3b 20 20 20 29 29 29 0a 20  x.    ;;   ))). 
7bd0: 20 20 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69     servers-matri
7be0: 78 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 54 68 65  x.    ))..;; The
7bf0: 20 6d 61 69 6e 20 6d 65 6e 75 0a 28 64 65 66 69   main menu.(defi
7c00: 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 6d 61 69 6e  ne (dcommon:main
7c10: 2d 6d 65 6e 75 29 0a 20 20 28 69 75 70 3a 6d 65  -menu).  (iup:me
7c20: 6e 75 20 3b 3b 20 61 20 6d 65 6e 75 20 69 73 20  nu ;; a menu is 
7c30: 61 20 73 70 65 63 69 61 6c 20 61 74 74 72 69 62  a special attrib
7c40: 75 74 65 20 74 6f 20 61 20 64 69 61 6c 6f 67 20  ute to a dialog 
7c50: 28 74 68 69 6e 6b 20 47 6e 6f 6d 65 20 70 75 74  (think Gnome put
7c60: 74 69 6e 67 20 74 68 65 20 6d 65 6e 75 20 61 74  ting the menu at
7c70: 20 73 63 72 65 65 6e 20 74 6f 70 29 0a 20 20 20   screen top).   
7c80: 28 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22  (iup:menu-item "
7c90: 46 69 6c 65 73 22 20 28 69 75 70 3a 6d 65 6e 75  Files" (iup:menu
7ca0: 20 20 20 3b 3b 20 4e 6f 74 65 20 74 68 61 74 20     ;; Note that 
7cb0: 79 6f 75 20 63 61 6e 20 75 73 65 20 65 69 74 68  you can use eith
7cc0: 65 72 20 23 3a 61 63 74 69 6f 6e 20 6f 72 20 61  er #:action or a
7cd0: 63 74 69 6f 6e 3a 20 66 6f 72 20 6f 70 74 69 6f  ction: for optio
7ce0: 6e 73 0a 09 09 09 20 20 20 28 69 75 70 3a 6d 65  ns....   (iup:me
7cf0: 6e 75 2d 69 74 65 6d 20 22 4f 70 65 6e 22 20 20  nu-item "Open"  
7d00: 61 63 74 69 6f 6e 3a 20 28 6c 61 6d 62 64 61 20  action: (lambda 
7d10: 28 6f 62 6a 29 0a 09 09 09 09 09 09 09 20 20 20  (obj)........   
7d20: 20 28 6c 65 74 2a 20 28 28 61 72 65 61 2d 6e 61   (let* ((area-na
7d30: 6d 65 20 28 69 75 70 3a 74 65 78 74 62 6f 78 20  me (iup:textbox 
7d40: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f  #:expand "HORIZO
7d50: 4e 54 41 4c 22 29 29 0a 09 09 09 09 09 09 09 09  NTAL")).........
7d60: 20 20 20 28 66 64 20 20 20 20 20 20 20 20 28 69     (fd        (i
7d70: 75 70 3a 66 69 6c 65 2d 64 69 61 6c 6f 67 20 23  up:file-dialog #
7d80: 3a 64 69 61 6c 6f 67 74 79 70 65 20 22 44 49 52  :dialogtype "DIR
7d90: 22 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 28  ")).........   (
7da0: 74 6f 70 20 20 20 20 20 20 20 28 69 75 70 3a 73  top       (iup:s
7db0: 68 6f 77 20 66 64 20 23 3a 6d 6f 64 61 6c 3f 20  how fd #:modal? 
7dc0: 22 59 45 53 22 29 29 29 0a 09 09 09 09 09 09 09  "YES")))........
7dd0: 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69        (iup:attri
7de0: 62 75 74 65 2d 73 65 74 21 20 73 6f 75 72 63 65  bute-set! source
7df0: 2d 74 62 20 22 56 41 4c 55 45 22 0a 09 09 09 09  -tb "VALUE".....
7e00: 09 09 09 09 09 09 20 20 28 69 75 70 3a 61 74 74  ......  (iup:att
7e10: 72 69 62 75 74 65 20 66 64 20 22 56 41 4c 55 45  ribute fd "VALUE
7e20: 22 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20  "))........     
7e30: 20 28 69 75 70 3a 64 65 73 74 72 6f 79 21 20 66   (iup:destroy! f
7e40: 64 29 29 29 29 0a 09 09 09 20 20 20 3b 3b 20 28  d))))....   ;; (
7e50: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09  lambda (obj)....
7e60: 20 20 20 3b 3b 20 20 28 69 75 70 3a 73 68 6f 77     ;;  (iup:show
7e70: 20 28 69 75 70 3a 66 69 6c 65 2d 64 69 61 6c 6f   (iup:file-dialo
7e80: 67 29 29 0a 09 09 09 20 20 20 3b 3b 20 20 28 70  g))....   ;;  (p
7e90: 72 69 6e 74 20 22 46 69 6c 65 2d 3e 6f 70 65 6e  rint "File->open
7ea0: 20 22 20 6f 62 6a 29 29 29 0a 09 09 09 20 20 20   " obj)))....   
7eb0: 28 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22  (iup:menu-item "
7ec0: 53 61 76 65 22 20 20 23 3a 61 63 74 69 6f 6e 20  Save"  #:action 
7ed0: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 70 72  (lambda (obj)(pr
7ee0: 69 6e 74 20 22 46 69 6c 65 2d 3e 73 61 76 65 20  int "File->save 
7ef0: 22 20 6f 62 6a 29 29 29 0a 09 09 09 20 20 20 28  " obj)))....   (
7f00: 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 45  iup:menu-item "E
7f10: 78 69 74 22 20 20 23 3a 61 63 74 69 6f 6e 20 28  xit"  #:action (
7f20: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 65 78 69  lambda (obj)(exi
7f30: 74 29 29 29 29 29 0a 20 20 20 28 69 75 70 3a 6d  t))))).   (iup:m
7f40: 65 6e 75 2d 69 74 65 6d 20 22 54 6f 6f 6c 73 22  enu-item "Tools"
7f50: 20 28 69 75 70 3a 6d 65 6e 75 0a 09 09 09 20 20   (iup:menu....  
7f60: 20 28 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20   (iup:menu-item 
7f70: 22 43 72 65 61 74 65 20 6e 65 77 20 62 6c 61 68  "Create new blah
7f80: 22 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62  " #:action (lamb
7f90: 64 61 20 28 6f 62 6a 29 28 70 72 69 6e 74 20 22  da (obj)(print "
7fa0: 54 6f 6f 6c 73 2d 3e 6e 65 77 20 62 6c 61 68 22  Tools->new blah"
7fb0: 29 29 29 0a 09 09 09 20 20 20 3b 3b 20 28 69 75  )))....   ;; (iu
7fc0: 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 53 68 6f  p:menu-item "Sho
7fd0: 77 20 64 69 61 6c 6f 67 22 20 20 20 20 20 23 3a  w dialog"     #:
7fe0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28  action (lambda (
7ff0: 6f 62 6a 29 0a 09 09 09 20 20 20 3b 3b 20 20 09  obj)....   ;;  .
8000: 09 09 09 09 20 20 20 28 73 68 6f 77 20 6d 65 73  ....   (show mes
8010: 73 61 67 65 2d 77 69 6e 64 6f 77 0a 09 09 09 20  sage-window.... 
8020: 20 20 3b 3b 20 20 09 09 09 09 09 20 20 20 20 20    ;;  .....     
8030: 23 3a 6d 6f 64 61 6c 3f 20 23 74 0a 09 09 09 20  #:modal? #t.... 
8040: 20 20 3b 3b 20 20 09 09 09 09 09 20 20 20 20 20    ;;  .....     
8050: 3b 3b 20 73 65 74 20 70 6f 73 69 74 6f 6e 20 75  ;; set positon u
8060: 73 69 6e 67 20 63 6f 6f 72 64 69 6e 61 74 65 73  sing coordinates
8070: 20 6f 72 20 63 65 6e 74 65 72 2c 20 73 74 61 72   or center, star
8080: 74 2c 20 74 6f 70 2c 20 6c 65 66 74 2c 20 65 6e  t, top, left, en
8090: 64 2c 20 62 6f 74 74 6f 6d 2c 20 72 69 67 68 74  d, bottom, right
80a0: 2c 20 70 61 72 65 6e 74 2d 63 65 6e 74 65 72 2c  , parent-center,
80b0: 20 63 75 72 72 65 6e 74 0a 09 09 09 20 20 20 3b   current....   ;
80c0: 3b 20 20 09 09 09 09 09 20 20 20 20 20 3b 3b 20  ;  .....     ;; 
80d0: 23 3a 78 20 27 6d 6f 75 73 65 0a 09 09 09 20 20  #:x 'mouse....  
80e0: 20 3b 3b 20 20 09 09 09 09 09 20 20 20 20 20 3b   ;;  .....     ;
80f0: 3b 20 23 3a 79 20 27 6d 6f 75 73 65 0a 09 09 09  ; #:y 'mouse....
8100: 20 20 20 3b 3b 20 20 29 09 09 09 09 09 20 20 20     ;;  ).....   
8110: 20 20 0a 09 09 09 20 20 20 29 29 29 29 0a 0a 3b    ....   ))))..;
8120: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ;===============
8130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
8140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
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 0a 3b 3b 20 43 41 4e 56 41  =======.;; CANVA
8170: 53 20 53 54 55 46 46 20 46 4f 52 20 54 45 53 54  S STUFF FOR TEST
8180: 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  S.;;============
8190: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
81a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
81b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
81c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66  ==========..(def
81d0: 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61  ine (dcommon:dra
81e0: 77 2d 74 65 73 74 20 63 6e 76 20 78 6f 66 66 73  w-test cnv xoffs
81f0: 65 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c 65  et yoffset scale
8200: 66 20 78 20 79 20 77 20 68 20 6e 61 6d 65 20 73  f x y w h name s
8210: 65 6c 65 63 74 65 64 29 0a 20 20 28 6c 65 74 2a  elected).  (let*
8220: 20 28 28 6c 6c 78 20 28 64 63 6f 6d 6d 6f 6e 3a   ((llx (dcommon:
8230: 78 2d 3e 63 61 6e 76 61 73 20 78 20 73 63 61 6c  x->canvas x scal
8240: 65 66 20 78 6f 66 66 73 65 74 29 29 0a 09 20 28  ef xoffset)).. (
8250: 6c 6c 79 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e  lly (dcommon:y->
8260: 63 61 6e 76 61 73 20 79 20 73 63 61 6c 65 66 20  canvas y scalef 
8270: 79 6f 66 66 73 65 74 29 29 0a 09 20 28 75 72 78  yoffset)).. (urx
8280: 20 28 64 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e   (dcommon:x->can
8290: 76 61 73 20 28 2b 20 78 20 77 29 20 73 63 61 6c  vas (+ x w) scal
82a0: 65 66 20 78 6f 66 66 73 65 74 29 29 0a 09 20 28  ef xoffset)).. (
82b0: 75 72 79 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e  ury (dcommon:y->
82c0: 63 61 6e 76 61 73 20 28 2b 20 79 20 68 29 20 73  canvas (+ y h) s
82d0: 63 61 6c 65 66 20 79 6f 66 66 73 65 74 29 29 29  calef yoffset)))
82e0: 0a 20 20 20 20 28 63 61 6e 76 61 73 2d 74 65 78  .    (canvas-tex
82f0: 74 21 20 63 6e 76 20 28 2b 20 6c 6c 78 20 35 29  t! cnv (+ llx 5)
8300: 28 2b 20 6c 6c 79 20 35 29 20 6e 61 6d 65 29 0a  (+ lly 5) name).
8310: 20 20 20 20 28 63 61 6e 76 61 73 2d 72 65 63 74      (canvas-rect
8320: 61 6e 67 6c 65 21 20 63 6e 76 20 6c 6c 78 20 75  angle! cnv llx u
8330: 72 78 20 6c 6c 79 20 75 72 79 29 0a 20 20 20 20  rx lly ury).    
8340: 28 69 66 20 73 65 6c 65 63 74 65 64 20 28 63 61  (if selected (ca
8350: 6e 76 61 73 2d 62 6f 78 21 20 63 6e 76 20 6c 6c  nvas-box! cnv ll
8360: 78 20 28 2b 20 6c 6c 78 20 35 29 20 6c 6c 79 20  x (+ llx 5) lly 
8370: 28 2b 20 6c 6c 79 20 35 29 29 29 29 29 0a 0a 28  (+ lly 5)))))..(
8380: 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a  define (dcommon:
8390: 64 72 61 77 2d 61 72 72 6f 77 20 63 6e 76 20 74  draw-arrow cnv t
83a0: 65 73 74 2d 62 6f 78 2d 63 65 6e 74 65 72 20 77  est-box-center w
83b0: 61 69 74 6f 6e 2d 63 65 6e 74 65 72 29 0a 20 20  aiton-center).  
83c0: 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 62 6f 78  (let* ((test-box
83d0: 2d 63 65 6e 74 65 72 2d 78 20 28 76 65 63 74 6f  -center-x (vecto
83e0: 72 2d 72 65 66 20 74 65 73 74 2d 62 6f 78 2d 63  r-ref test-box-c
83f0: 65 6e 74 65 72 20 30 29 29 0a 09 20 28 74 65 73  enter 0)).. (tes
8400: 74 2d 62 6f 78 2d 63 65 6e 74 65 72 2d 79 20 28  t-box-center-y (
8410: 76 65 63 74 6f 72 2d 72 65 66 20 74 65 73 74 2d  vector-ref test-
8420: 62 6f 78 2d 63 65 6e 74 65 72 20 31 29 29 0a 09  box-center 1))..
8430: 20 28 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 2d   (waiton-center-
8440: 78 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20  x   (vector-ref 
8450: 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 20 20 20  waiton-center   
8460: 30 29 29 0a 09 20 28 77 61 69 74 6f 6e 2d 63 65  0)).. (waiton-ce
8470: 6e 74 65 72 2d 79 20 20 20 28 76 65 63 74 6f 72  nter-y   (vector
8480: 2d 72 65 66 20 77 61 69 74 6f 6e 2d 63 65 6e 74  -ref waiton-cent
8490: 65 72 20 20 20 31 29 29 0a 09 20 28 64 65 6c 74  er   1)).. (delt
84a0: 61 2d 79 20 20 20 20 20 20 20 20 20 20 20 28 2d  a-y           (-
84b0: 20 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 2d 79   waiton-center-y
84c0: 20 74 65 73 74 2d 62 6f 78 2d 63 65 6e 74 65 72   test-box-center
84d0: 2d 79 29 29 0a 09 20 28 64 65 6c 74 61 2d 78 20  -y)).. (delta-x 
84e0: 20 20 20 20 20 20 20 20 20 20 28 2d 20 77 61 69            (- wai
84f0: 74 6f 6e 2d 63 65 6e 74 65 72 2d 78 20 74 65 73  ton-center-x tes
8500: 74 2d 62 6f 78 2d 63 65 6e 74 65 72 2d 78 29 29  t-box-center-x))
8510: 0a 09 20 28 61 62 73 2d 64 65 6c 74 61 2d 78 20  .. (abs-delta-x 
8520: 20 20 20 20 20 20 28 61 62 73 20 64 65 6c 74 61        (abs delta
8530: 2d 78 29 29 0a 09 20 28 61 62 73 2d 64 65 6c 74  -x)).. (abs-delt
8540: 61 2d 79 20 20 20 20 20 20 20 28 61 62 73 20 64  a-y       (abs d
8550: 65 6c 74 61 2d 79 29 29 0a 09 20 28 75 73 65 2d  elta-y)).. (use-
8560: 64 65 6c 74 61 2d 78 20 20 20 20 20 20 20 28 3e  delta-x       (>
8570: 20 61 62 73 2d 64 65 6c 74 61 2d 78 20 61 62 73   abs-delta-x abs
8580: 2d 64 65 6c 74 61 2d 79 29 29 20 3b 3b 20 75 73  -delta-y)) ;; us
8590: 65 20 74 68 65 20 6c 61 72 67 65 72 20 6f 6e 65  e the larger one
85a0: 0a 09 20 28 64 65 6c 74 61 2d 72 61 74 69 6f 20  .. (delta-ratio 
85b0: 20 20 20 20 20 20 28 69 66 20 75 73 65 2d 64 65        (if use-de
85c0: 6c 74 61 2d 78 0a 09 09 09 09 28 69 66 20 28 3e  lta-x.....(if (>
85d0: 20 61 62 73 2d 64 65 6c 74 61 2d 78 20 30 29 0a   abs-delta-x 0).
85e0: 09 09 09 09 20 20 20 20 28 2f 20 61 62 73 2d 64  ....    (/ abs-d
85f0: 65 6c 74 61 2d 79 20 61 62 73 2d 64 65 6c 74 61  elta-y abs-delta
8600: 2d 78 29 0a 09 09 09 09 20 20 20 20 31 29 0a 09  -x).....    1)..
8610: 09 09 09 28 69 66 20 28 3e 20 61 62 73 2d 64 65  ...(if (> abs-de
8620: 6c 74 61 2d 79 20 30 29 0a 09 09 09 09 20 20 20  lta-y 0).....   
8630: 20 28 2f 20 61 62 73 2d 64 65 6c 74 61 2d 78 20   (/ abs-delta-x 
8640: 61 62 73 2d 64 65 6c 74 61 2d 79 29 0a 09 09 09  abs-delta-y)....
8650: 09 20 20 20 20 31 29 29 29 0a 09 20 28 78 2d 61  .    1))).. (x-a
8660: 64 6a 20 20 20 20 20 20 20 20 20 20 20 20 20 28  dj             (
8670: 69 66 20 75 73 65 2d 64 65 6c 74 61 2d 78 0a 09  if use-delta-x..
8680: 09 09 09 38 0a 09 09 09 09 28 2a 20 64 65 6c 74  ...8.....(* delt
8690: 61 2d 72 61 74 69 6f 20 38 29 29 29 0a 09 20 28  a-ratio 8))).. (
86a0: 79 2d 61 64 6a 20 20 20 20 20 20 20 20 20 20 20  y-adj           
86b0: 20 20 28 69 66 20 75 73 65 2d 64 65 6c 74 61 2d    (if use-delta-
86c0: 78 0a 09 09 09 09 28 2a 20 78 2d 61 64 6a 20 64  x.....(* x-adj d
86d0: 65 6c 74 61 2d 72 61 74 69 6f 29 0a 09 09 09 09  elta-ratio).....
86e0: 38 29 29 0a 09 20 28 6e 65 77 2d 77 61 69 74 6f  8)).. (new-waito
86f0: 6e 2d 78 20 20 20 20 20 20 28 69 6e 65 78 61 63  n-x      (inexac
8700: 74 2d 3e 65 78 61 63 74 0a 09 09 09 20 20 20 20  t->exact....    
8710: 20 28 72 6f 75 6e 64 20 28 69 66 20 28 3e 20 64   (round (if (> d
8720: 65 6c 74 61 2d 78 20 30 29 20 3b 3b 20 68 61 76  elta-x 0) ;; hav
8730: 65 20 70 6f 73 69 74 69 76 65 20 78 0a 09 09 09  e positive x....
8740: 09 09 28 2d 20 77 61 69 74 6f 6e 2d 63 65 6e 74  ..(- waiton-cent
8750: 65 72 2d 78 20 78 2d 61 64 6a 29 0a 09 09 09 09  er-x x-adj).....
8760: 09 28 2b 20 77 61 69 74 6f 6e 2d 63 65 6e 74 65  .(+ waiton-cente
8770: 72 2d 78 20 78 2d 61 64 6a 29 29 29 29 29 0a 09  r-x x-adj)))))..
8780: 20 28 6e 65 77 2d 77 61 69 74 6f 6e 2d 79 20 20   (new-waiton-y  
8790: 20 20 20 20 28 69 6e 65 78 61 63 74 2d 3e 65 78      (inexact->ex
87a0: 61 63 74 0a 09 09 09 20 20 20 20 20 28 72 6f 75  act....     (rou
87b0: 6e 64 20 28 69 66 20 28 3e 20 64 65 6c 74 61 2d  nd (if (> delta-
87c0: 79 20 30 29 0a 09 09 09 09 09 28 2d 20 77 61 69  y 0)......(- wai
87d0: 74 6f 6e 2d 63 65 6e 74 65 72 2d 79 20 79 2d 61  ton-center-y y-a
87e0: 64 6a 29 0a 09 09 09 09 09 28 2b 20 77 61 69 74  dj)......(+ wait
87f0: 6f 6e 2d 63 65 6e 74 65 72 2d 79 20 79 2d 61 64  on-center-y y-ad
8800: 6a 29 29 29 29 29 29 0a 20 20 3b 3b 20 28 63 61  j)))))).  ;; (ca
8810: 6e 76 61 73 2d 6c 69 6e 65 2d 77 69 64 74 68 2d  nvas-line-width-
8820: 73 65 74 21 20 63 6e 76 20 35 29 0a 20 20 28 63  set! cnv 5).  (c
8830: 61 6e 76 61 73 2d 6c 69 6e 65 21 20 63 6e 76 0a  anvas-line! cnv.
8840: 09 09 74 65 73 74 2d 62 6f 78 2d 63 65 6e 74 65  ..test-box-cente
8850: 72 2d 78 0a 09 09 74 65 73 74 2d 62 6f 78 2d 63  r-x...test-box-c
8860: 65 6e 74 65 72 2d 79 0a 09 09 6e 65 77 2d 77 61  enter-y...new-wa
8870: 69 74 6f 6e 2d 78 0a 09 09 6e 65 77 2d 77 61 69  iton-x...new-wai
8880: 74 6f 6e 2d 79 0a 09 09 29 0a 20 20 28 63 61 6e  ton-y...).  (can
8890: 76 61 73 2d 6d 61 72 6b 21 20 63 6e 76 20 6e 65  vas-mark! cnv ne
88a0: 77 2d 77 61 69 74 6f 6e 2d 78 20 6e 65 77 2d 77  w-waiton-x new-w
88b0: 61 69 74 6f 6e 2d 79 29 29 29 0a 0a 28 64 65 66  aiton-y)))..(def
88c0: 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74  ine (dcommon:get
88d0: 2d 62 6f 78 2d 63 65 6e 74 65 72 20 62 6f 78 29  -box-center box)
88e0: 0a 20 20 28 6c 65 74 2a 20 28 28 6c 6c 78 20 20  .  (let* ((llx  
88f0: 28 6c 69 73 74 2d 72 65 66 20 62 6f 78 20 30 29  (list-ref box 0)
8900: 29 0a 09 20 28 6c 6c 79 20 20 28 6c 69 73 74 2d  ).. (lly  (list-
8910: 72 65 66 20 62 6f 78 20 31 29 29 0a 09 20 28 62  ref box 1)).. (b
8920: 6f 78 77 20 28 6c 69 73 74 2d 72 65 66 20 62 6f  oxw (list-ref bo
8930: 78 20 34 29 29 0a 09 20 28 62 6f 78 68 20 28 6c  x 4)).. (boxh (l
8940: 69 73 74 2d 72 65 66 20 62 6f 78 20 35 29 29 29  ist-ref box 5)))
8950: 0a 20 20 20 20 28 76 65 63 74 6f 72 20 28 2b 20  .    (vector (+ 
8960: 6c 6c 78 20 28 2f 20 62 6f 78 77 20 32 29 29 0a  llx (/ boxw 2)).
8970: 09 20 20 20 20 28 2b 20 6c 6c 79 20 28 2f 20 62  .    (+ lly (/ b
8980: 6f 78 68 20 32 29 29 29 29 29 0a 0a 28 64 65 66  oxh 2)))))..(def
8990: 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 6e 75 6d 2d  ine-inline (num-
89a0: 3e 69 6e 74 20 6e 75 6d 29 0a 20 20 28 69 6e 65  >int num).  (ine
89b0: 78 61 63 74 2d 3e 65 78 61 63 74 20 28 72 6f 75  xact->exact (rou
89c0: 6e 64 20 6e 75 6d 29 29 29 0a 0a 28 64 65 66 69  nd num)))..(defi
89d0: 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77  ne (dcommon:draw
89e0: 2d 65 64 67 65 73 20 63 6e 76 20 78 6f 66 66 73  -edges cnv xoffs
89f0: 65 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c 65  et yoffset scale
8a00: 66 20 65 64 67 65 73 29 0a 20 20 28 66 6f 72 2d  f edges).  (for-
8a10: 65 61 63 68 0a 20 20 20 28 6c 61 6d 62 64 61 20  each.   (lambda 
8a20: 28 65 29 0a 20 20 20 20 20 28 6c 65 74 20 6c 6f  (e).     (let lo
8a30: 6f 70 20 28 28 78 31 20 28 63 61 72 20 65 29 29  op ((x1 (car e))
8a40: 0a 09 09 28 79 31 20 28 63 61 64 72 20 65 29 29  ...(y1 (cadr e))
8a50: 0a 09 09 28 78 32 20 23 66 29 0a 09 09 28 79 32  ...(x2 #f)...(y2
8a60: 20 23 66 29 0a 09 09 28 74 61 6c 20 28 63 64 64   #f)...(tal (cdd
8a70: 72 20 65 29 29 29 0a 20 20 20 20 20 20 20 28 69  r e))).       (i
8a80: 66 20 28 61 6e 64 20 78 31 20 79 31 20 78 32 20  f (and x1 y1 x2 
8a90: 79 32 29 0a 09 20 20 20 28 63 61 6e 76 61 73 2d  y2)..   (canvas-
8aa0: 6c 69 6e 65 21 20 0a 09 20 20 20 20 63 6e 76 20  line! ..    cnv 
8ab0: 0a 09 20 20 20 20 28 6e 75 6d 2d 3e 69 6e 74 20  ..    (num->int 
8ac0: 28 64 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76  (dcommon:x->canv
8ad0: 61 73 20 78 31 20 73 63 61 6c 65 66 20 78 6f 66  as x1 scalef xof
8ae0: 66 73 65 74 29 29 0a 09 20 20 20 20 28 6e 75 6d  fset))..    (num
8af0: 2d 3e 69 6e 74 20 28 64 63 6f 6d 6d 6f 6e 3a 79  ->int (dcommon:y
8b00: 2d 3e 63 61 6e 76 61 73 20 79 31 20 73 63 61 6c  ->canvas y1 scal
8b10: 65 66 20 79 6f 66 66 73 65 74 29 29 0a 09 20 20  ef yoffset))..  
8b20: 20 20 28 6e 75 6d 2d 3e 69 6e 74 20 28 64 63 6f    (num->int (dco
8b30: 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 73 20 78  mmon:x->canvas x
8b40: 32 20 73 63 61 6c 65 66 20 78 6f 66 66 73 65 74  2 scalef xoffset
8b50: 29 29 0a 09 20 20 20 20 28 6e 75 6d 2d 3e 69 6e  ))..    (num->in
8b60: 74 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e 63 61  t (dcommon:y->ca
8b70: 6e 76 61 73 20 79 32 20 73 63 61 6c 65 66 20 79  nvas y2 scalef y
8b80: 6f 66 66 73 65 74 29 29 29 29 20 3b 3b 20 28 6e  offset)))) ;; (n
8b90: 75 6d 2d 3e 69 6e 74 20 78 31 29 28 6e 75 6d 2d  um->int x1)(num-
8ba0: 3e 69 6e 74 20 79 31 29 28 6e 75 6d 2d 3e 69 6e  >int y1)(num->in
8bb0: 74 20 78 32 29 28 6e 75 6d 2d 3e 69 6e 74 20 79  t x2)(num->int y
8bc0: 32 29 29 29 0a 20 20 20 20 20 20 20 28 69 66 20  2))).       (if 
8bd0: 28 3c 20 28 6c 65 6e 67 74 68 20 74 61 6c 29 20  (< (length tal) 
8be0: 32 29 0a 09 20 20 20 28 63 61 6e 76 61 73 2d 6d  2)..   (canvas-m
8bf0: 61 72 6b 21 20 63 6e 76 0a 09 09 09 20 28 6e 75  ark! cnv.... (nu
8c00: 6d 2d 3e 69 6e 74 20 28 64 63 6f 6d 6d 6f 6e 3a  m->int (dcommon:
8c10: 78 2d 3e 63 61 6e 76 61 73 20 78 31 20 73 63 61  x->canvas x1 sca
8c20: 6c 65 66 20 78 6f 66 66 73 65 74 29 29 0a 09 09  lef xoffset))...
8c30: 09 20 28 6e 75 6d 2d 3e 69 6e 74 20 28 64 63 6f  . (num->int (dco
8c40: 6d 6d 6f 6e 3a 79 2d 3e 63 61 6e 76 61 73 20 79  mmon:y->canvas y
8c50: 31 20 73 63 61 6c 65 66 20 79 6f 66 66 73 65 74  1 scalef yoffset
8c60: 29 29 29 20 3b 3b 20 28 6e 75 6d 2d 3e 69 6e 74  ))) ;; (num->int
8c70: 20 78 31 29 28 6e 75 6d 2d 3e 69 6e 74 20 79 31   x1)(num->int y1
8c80: 29 29 0a 09 20 20 20 28 6c 6f 6f 70 20 28 63 61  ))..   (loop (ca
8c90: 72 20 74 61 6c 29 28 63 61 64 72 20 74 61 6c 29  r tal)(cadr tal)
8ca0: 20 78 31 20 79 31 20 28 63 64 64 72 20 74 61 6c   x1 y1 (cddr tal
8cb0: 29 29 29 29 29 0a 20 20 20 3b 3b 20 28 6d 61 70  ))))).   ;; (map
8cc0: 20 28 6c 61 6d 62 64 61 20 28 65 29 28 6d 61 70   (lambda (e)(map
8cd0: 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 75 6d   (lambda (x)(num
8ce0: 2d 3e 69 6e 74 20 28 2a 20 78 20 73 63 61 6c 65  ->int (* x scale
8cf0: 66 29 29 29 20 65 29 29 20 65 64 67 65 73 29 29  f))) e)) edges))
8d00: 29 0a 20 20 20 65 64 67 65 73 29 29 0a 0a 0a 28  ).   edges))...(
8d10: 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a  define (dcommon:
8d20: 64 72 61 77 2d 61 72 72 6f 77 73 20 63 6e 76 20  draw-arrows cnv 
8d30: 74 65 73 74 6e 61 6d 65 20 74 65 73 74 73 2d 68  testname tests-h
8d40: 61 73 68 20 74 65 73 74 2d 72 65 63 6f 72 64 73  ash test-records
8d50: 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74  ).  (let* ((test
8d60: 2d 62 6f 78 2d 69 6e 66 6f 20 20 20 28 68 61 73  -box-info   (has
8d70: 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74  h-table-ref test
8d80: 73 2d 68 61 73 68 20 74 65 73 74 6e 61 6d 65 29  s-hash testname)
8d90: 29 0a 09 20 28 74 65 73 74 2d 62 6f 78 2d 63 65  ).. (test-box-ce
8da0: 6e 74 65 72 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65  nter (dcommon:ge
8db0: 74 2d 62 6f 78 2d 63 65 6e 74 65 72 20 74 65 73  t-box-center tes
8dc0: 74 2d 62 6f 78 2d 69 6e 66 6f 29 29 0a 09 20 28  t-box-info)).. (
8dd0: 74 65 73 74 2d 72 65 63 6f 72 64 20 20 20 20 20  test-record     
8de0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20  (hash-table-ref 
8df0: 74 65 73 74 2d 72 65 63 6f 72 64 73 20 74 65 73  test-records tes
8e00: 74 6e 61 6d 65 29 29 0a 09 20 28 77 61 69 74 6f  tname)).. (waito
8e10: 6e 73 20 20 20 20 20 20 20 20 20 28 76 65 63 74  ns         (vect
8e20: 6f 72 2d 72 65 66 20 74 65 73 74 2d 72 65 63 6f  or-ref test-reco
8e30: 72 64 20 32 29 29 29 0a 20 20 20 20 28 66 6f 72  rd 2))).    (for
8e40: 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62  -each.     (lamb
8e50: 64 61 20 28 77 61 69 74 6f 6e 29 0a 20 20 20 20  da (waiton).    
8e60: 20 20 20 28 6c 65 74 2a 20 28 28 77 61 69 74 6f     (let* ((waito
8e70: 6e 2d 62 6f 78 2d 69 6e 66 6f 20 28 68 61 73 68  n-box-info (hash
8e80: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75  -table-ref/defau
8e90: 6c 74 20 74 65 73 74 73 2d 68 61 73 68 20 77 61  lt tests-hash wa
8ea0: 69 74 6f 6e 20 23 66 29 29 0a 09 20 20 20 20 20  iton #f))..     
8eb0: 20 28 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 20   (waiton-center 
8ec0: 20 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 62    (dcommon:get-b
8ed0: 6f 78 2d 63 65 6e 74 65 72 20 28 6f 72 20 77 61  ox-center (or wa
8ee0: 69 74 6f 6e 2d 62 6f 78 2d 69 6e 66 6f 20 74 65  iton-box-info te
8ef0: 73 74 2d 62 6f 78 2d 69 6e 66 6f 29 29 29 29 0a  st-box-info)))).
8f00: 09 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d  . (dcommon:draw-
8f10: 61 72 72 6f 77 20 63 6e 76 20 74 65 73 74 2d 62  arrow cnv test-b
8f20: 6f 78 2d 63 65 6e 74 65 72 20 77 61 69 74 6f 6e  ox-center waiton
8f30: 2d 63 65 6e 74 65 72 29 29 29 0a 20 20 20 20 20  -center))).     
8f40: 77 61 69 74 6f 6e 73 29 0a 20 20 20 20 3b 3b 20  waitons).    ;; 
8f50: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a  (debug:print 0 *
8f60: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74  default-log-port
8f70: 2a 20 22 74 65 73 74 2d 62 6f 78 2d 69 6e 66 6f  * "test-box-info
8f80: 3d 22 20 74 65 73 74 2d 62 6f 78 2d 69 6e 66 6f  =" test-box-info
8f90: 29 0a 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a  ).    ;; (debug:
8fa0: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74  print 0 *default
8fb0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 74 65 73 74  -log-port* "test
8fc0: 2d 72 65 63 6f 72 64 3d 22 20 74 65 73 74 2d 72  -record=" test-r
8fd0: 65 63 6f 72 64 29 0a 20 20 20 20 29 29 0a 0a 28  ecord).    ))..(
8fe0: 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a  define (dcommon:
8ff0: 65 73 74 69 6d 61 74 65 2d 73 63 61 6c 65 20 73  estimate-scale s
9000: 69 7a 65 78 20 73 69 7a 65 79 20 6f 72 69 67 69  izex sizey origi
9010: 6e 78 20 6f 72 69 67 69 6e 79 20 6e 6f 64 65 73  nx originy nodes
9020: 29 0a 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 73  ).  ;; (print "s
9030: 69 7a 65 78 3a 20 22 20 73 69 7a 65 78 20 22 20  izex: " sizex " 
9040: 73 69 7a 65 79 3a 20 22 20 73 69 7a 65 79 20 22  sizey: " sizey "
9050: 20 6f 72 69 67 69 6e 78 3a 20 22 20 6f 72 69 67   originx: " orig
9060: 69 6e 78 20 22 20 6f 72 69 67 69 6e 79 3a 20 22  inx " originy: "
9070: 20 6f 72 69 67 69 6e 79 20 22 20 6e 6f 64 65 73   originy " nodes
9080: 3a 20 22 20 6e 6f 64 65 73 29 0a 20 20 28 6c 65  : " nodes).  (le
9090: 74 2a 20 28 28 6d 61 78 78 20 31 29 0a 09 20 28  t* ((maxx 1).. (
90a0: 6d 61 78 79 20 31 29 29 0a 20 20 20 20 28 66 6f  maxy 1)).    (fo
90b0: 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d  r-each.     (lam
90c0: 62 64 61 20 28 6e 6f 64 65 29 0a 20 20 20 20 20  bda (node).     
90d0: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 63    (if (equal? (c
90e0: 61 72 20 6e 6f 64 65 29 20 22 6e 6f 64 65 22 29  ar node) "node")
90f0: 0a 09 20 20 20 28 6c 65 74 20 28 28 78 20 28 73  ..   (let ((x (s
9100: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6c  tring->number (l
9110: 69 73 74 2d 72 65 66 20 6e 6f 64 65 20 32 29 29  ist-ref node 2))
9120: 29 0a 09 09 20 28 79 20 28 73 74 72 69 6e 67 2d  )... (y (string-
9130: 3e 6e 75 6d 62 65 72 20 28 6c 69 73 74 2d 72 65  >number (list-re
9140: 66 20 6e 6f 64 65 20 33 29 29 29 29 0a 09 20 20  f node 3))))..  
9150: 20 20 20 28 69 66 20 28 61 6e 64 20 78 20 28 3e     (if (and x (>
9160: 20 78 20 6d 61 78 78 29 29 28 73 65 74 21 20 6d   x maxx))(set! m
9170: 61 78 78 20 78 29 29 0a 09 20 20 20 20 20 28 69  axx x))..     (i
9180: 66 20 28 61 6e 64 20 79 20 28 3e 20 79 20 6d 61  f (and y (> y ma
9190: 78 79 29 29 28 73 65 74 21 20 6d 61 78 79 20 79  xy))(set! maxy y
91a0: 29 29 29 29 29 0a 20 20 20 20 20 6e 6f 64 65 73  ))))).     nodes
91b0: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 73 63 61  ).    (let ((sca
91c0: 6c 65 78 20 28 2f 20 73 69 7a 65 78 20 6d 61 78  lex (/ sizex max
91d0: 78 29 29 0a 09 20 20 28 73 63 61 6c 65 79 20 28  x))..  (scaley (
91e0: 2f 20 73 69 7a 65 79 20 6d 61 78 79 29 29 29 0a  / sizey maxy))).
91f0: 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20        ;; (print 
9200: 22 6d 61 78 78 3a 20 22 20 6d 61 78 78 20 22 20  "maxx: " maxx " 
9210: 6d 61 78 79 3a 20 22 20 6d 61 78 79 20 22 20 73  maxy: " maxy " s
9220: 63 61 6c 65 78 3a 20 22 20 73 63 61 6c 65 78 20  calex: " scalex 
9230: 22 20 73 63 61 6c 65 79 3a 20 22 20 73 63 61 6c  " scaley: " scal
9240: 65 79 29 0a 20 20 20 20 20 20 28 6d 69 6e 20 73  ey).      (min s
9250: 63 61 6c 65 78 20 73 63 61 6c 65 79 29 29 29 29  calex scaley))))
9260: 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d  ..(define (dcomm
9270: 6f 6e 3a 67 65 74 2d 78 6f 66 66 73 65 74 20 74  on:get-xoffset t
9280: 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20  ests-draw-state 
9290: 73 69 7a 65 78 2d 69 6e 20 78 61 64 6a 2d 69 6e  sizex-in xadj-in
92a0: 29 0a 20 20 28 6c 65 74 20 28 28 78 61 64 6a 20  ).  (let ((xadj 
92b0: 20 28 6f 72 20 78 61 64 6a 2d 69 6e 20 20 28 68   (or xadj-in  (h
92c0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65  ash-table-ref/de
92d0: 66 61 75 6c 74 20 74 65 73 74 73 2d 64 72 61 77  fault tests-draw
92e0: 2d 73 74 61 74 65 20 27 78 61 64 6a 20 30 29 29  -state 'xadj 0))
92f0: 29 0a 09 28 73 69 7a 65 78 20 28 6f 72 20 73 69  )..(sizex (or si
9300: 7a 65 78 2d 69 6e 20 28 68 61 73 68 2d 74 61 62  zex-in (hash-tab
9310: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74  le-ref/default t
9320: 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20  ests-draw-state 
9330: 27 73 69 7a 65 78 20 35 30 30 29 29 29 29 0a 20  'sizex 500)))). 
9340: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73     (hash-table-s
9350: 65 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d 73  et! tests-draw-s
9360: 74 61 74 65 20 27 78 61 64 6a 20 78 61 64 6a 29  tate 'xadj xadj)
9370: 20 3b 3b 20 66 6f 72 20 75 73 65 20 69 6e 20 64   ;; for use in d
9380: 65 2d 73 63 61 6c 69 6e 67 20 77 68 65 6e 20 68  e-scaling when h
9390: 61 6e 64 6c 69 6e 67 20 6d 6f 75 73 65 20 63 6c  andling mouse cl
93a0: 69 63 6b 73 0a 20 20 20 20 28 68 61 73 68 2d 74  icks.    (hash-t
93b0: 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d  able-set! tests-
93c0: 64 72 61 77 2d 73 74 61 74 65 20 27 73 69 7a 65  draw-state 'size
93d0: 78 20 73 69 7a 65 78 29 0a 20 20 20 20 28 2a 20  x sizex).    (* 
93e0: 28 2f 20 73 69 7a 65 78 20 32 29 20 28 2d 20 30  (/ sizex 2) (- 0
93f0: 2e 35 20 78 61 64 6a 29 29 29 29 0a 0a 28 64 65  .5 xadj))))..(de
9400: 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65  fine (dcommon:ge
9410: 74 2d 79 6f 66 66 73 65 74 20 74 65 73 74 73 2d  t-yoffset tests-
9420: 64 72 61 77 2d 73 74 61 74 65 20 73 69 7a 65 79  draw-state sizey
9430: 2d 69 6e 20 79 61 64 6a 2d 69 6e 29 0a 20 20 28  -in yadj-in).  (
9440: 6c 65 74 20 28 28 79 61 64 6a 20 20 28 6f 72 20  let ((yadj  (or 
9450: 79 61 64 6a 2d 69 6e 20 20 28 68 61 73 68 2d 74  yadj-in  (hash-t
9460: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74  able-ref/default
9470: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74   tests-draw-stat
9480: 65 20 27 79 61 64 6a 20 30 29 29 29 0a 09 28 73  e 'yadj 0)))..(s
9490: 69 7a 65 79 20 28 6f 72 20 73 69 7a 65 79 2d 69  izey (or sizey-i
94a0: 6e 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65  n (hash-table-re
94b0: 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 73 2d  f/default tests-
94c0: 64 72 61 77 2d 73 74 61 74 65 20 27 73 69 7a 65  draw-state 'size
94d0: 79 20 35 30 30 29 29 29 29 0a 20 20 20 20 28 68  y 500)))).    (h
94e0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74  ash-table-set! t
94f0: 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20  ests-draw-state 
9500: 27 79 61 64 6a 20 79 61 64 6a 29 20 3b 3b 20 66  'yadj yadj) ;; f
9510: 6f 72 20 75 73 65 20 69 6e 20 64 65 2d 73 63 61  or use in de-sca
9520: 6c 69 6e 67 20 77 68 65 6e 20 68 61 6e 64 6c 69  ling when handli
9530: 6e 67 20 6d 6f 75 73 65 20 63 6c 69 63 6b 73 0a  ng mouse clicks.
9540: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d      (hash-table-
9550: 73 65 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d  set! tests-draw-
9560: 73 74 61 74 65 20 27 73 69 7a 65 79 20 73 69 7a  state 'sizey siz
9570: 65 79 29 0a 20 20 20 20 28 2a 20 28 2f 20 73 69  ey).    (* (/ si
9580: 7a 65 79 20 32 29 20 28 2d 20 79 61 64 6a 20 30  zey 2) (- yadj 0
9590: 2e 35 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20  .5))))..(define 
95a0: 28 64 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76  (dcommon:x->canv
95b0: 61 73 20 78 20 73 63 61 6c 65 66 20 78 6f 66 66  as x scalef xoff
95c0: 73 65 74 29 0a 20 20 28 2b 20 78 6f 66 66 73 65  set).  (+ xoffse
95d0: 74 20 28 2a 20 78 20 73 63 61 6c 65 66 29 29 29  t (* x scalef)))
95e0: 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d  ..(define (dcomm
95f0: 6f 6e 3a 79 2d 3e 63 61 6e 76 61 73 20 79 20 73  on:y->canvas y s
9600: 63 61 6c 65 66 20 79 6f 66 66 73 65 74 29 0a 20  calef yoffset). 
9610: 20 28 2b 20 79 6f 66 66 73 65 74 20 28 2a 20 79   (+ yoffset (* y
9620: 20 73 63 61 6c 65 66 29 29 29 0a 0a 3b 3b 20 73   scalef)))..;; s
9630: 69 7a 65 78 2c 20 73 69 7a 65 79 20 20 20 20 20  izex, sizey     
9640: 2d 20 63 61 6e 76 61 73 20 73 69 7a 65 0a 3b 3b  - canvas size.;;
9650: 20 6f 72 69 67 69 6e 78 2c 20 6f 72 69 67 69 6e   originx, origin
9660: 79 20 2d 20 63 61 6e 76 61 73 20 6f 72 69 67 69  y - canvas origi
9670: 6e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 63  n.;;.(define (dc
9680: 6f 6d 6d 6f 6e 3a 69 6e 69 74 69 61 6c 2d 64 72  ommon:initial-dr
9690: 61 77 2d 74 65 73 74 73 20 63 6e 76 20 78 61 64  aw-tests cnv xad
96a0: 6a 20 79 61 64 6a 20 73 69 7a 65 78 20 73 69 7a  j yadj sizex siz
96b0: 65 79 20 73 69 7a 65 78 6d 6d 20 73 69 7a 65 79  ey sizexmm sizey
96c0: 6d 6d 20 6f 72 69 67 69 6e 78 20 6f 72 69 67 69  mm originx origi
96d0: 6e 79 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74  ny tests-draw-st
96e0: 61 74 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e  ate sorted-testn
96f0: 61 6d 65 73 20 74 65 73 74 2d 72 65 63 6f 72 64  ames test-record
9700: 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 6f 74  s).  (let* ((dot
9710: 2d 64 61 74 61 20 3b 3b 20 28 6d 61 70 20 63 64  -data ;; (map cd
9720: 72 20 28 66 69 6c 74 65 72 0a 09 09 20 20 20 3b  r (filter...   ;
9730: 3b 20 09 20 20 28 6c 61 6d 62 64 61 20 28 78 29  ; .  (lambda (x)
9740: 28 65 71 75 61 6c 3f 20 22 6e 6f 64 65 22 20 28  (equal? "node" (
9750: 63 61 72 20 78 29 29 29 0a 09 20 20 28 6d 61 70  car x)))..  (map
9760: 20 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 74   string-split (t
9770: 65 73 74 73 3a 6c 61 7a 79 2d 64 6f 74 20 74 65  ests:lazy-dot te
9780: 73 74 2d 72 65 63 6f 72 64 73 20 22 70 6c 61 69  st-records "plai
9790: 6e 22 20 73 69 7a 65 78 20 73 69 7a 65 79 29 29  n" sizex sizey))
97a0: 29 20 3b 3b 20 28 74 65 73 74 73 3a 65 61 73 79  ) ;; (tests:easy
97b0: 2d 64 6f 74 20 74 65 73 74 2d 72 65 63 6f 72 64  -dot test-record
97c0: 73 20 22 70 6c 61 69 6e 22 29 29 29 0a 09 20 28  s "plain"))).. (
97d0: 78 6f 66 66 73 65 74 09 20 28 64 63 6f 6d 6d 6f  xoffset. (dcommo
97e0: 6e 3a 67 65 74 2d 78 6f 66 66 73 65 74 20 74 65  n:get-xoffset te
97f0: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 73  sts-draw-state s
9800: 69 7a 65 78 20 78 61 64 6a 29 29 0a 09 20 28 79  izex xadj)).. (y
9810: 6f 66 66 73 65 74 20 20 20 20 20 20 20 20 28 64  offset        (d
9820: 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 79 6f 66 66 73  common:get-yoffs
9830: 65 74 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74  et tests-draw-st
9840: 61 74 65 20 73 69 7a 65 79 20 79 61 64 6a 29 29  ate sizey yadj))
9850: 0a 09 20 28 6e 6f 2d 64 6f 74 20 20 20 20 20 20  .. (no-dot      
9860: 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b     (configf:look
9870: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22  up *configdat* "
9880: 73 65 74 75 70 22 20 22 6e 6f 64 6f 74 22 29 29  setup" "nodot"))
9890: 0a 09 20 28 62 6f 78 68 20 20 20 20 20 20 20 20  .. (boxh        
98a0: 20 20 20 31 35 29 0a 09 20 28 62 6f 78 77 20 20     15).. (boxw  
98b0: 20 20 20 20 20 20 20 20 20 31 30 29 0a 09 20 28           10).. (
98c0: 6d 61 72 67 69 6e 20 20 20 20 20 20 20 20 20 35  margin         5
98d0: 29 0a 09 20 28 74 65 73 74 73 2d 69 6e 66 6f 20  ).. (tests-info 
98e0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d      (hash-table-
98f0: 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73  ref tests-draw-s
9900: 74 61 74 65 20 27 74 65 73 74 73 2d 69 6e 66 6f  tate 'tests-info
9910: 29 29 0a 09 20 28 73 65 6c 65 63 74 65 64 2d 74  )).. (selected-t
9920: 65 73 74 73 20 28 68 61 73 68 2d 74 61 62 6c 65  ests (hash-table
9930: 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d  -ref tests-draw-
9940: 73 74 61 74 65 20 27 73 65 6c 65 63 74 65 64 2d  state 'selected-
9950: 74 65 73 74 73 20 29 29 0a 09 20 28 73 63 61 6c  tests )).. (scal
9960: 65 66 20 20 20 20 20 20 20 20 20 28 69 66 20 6e  ef         (if n
9970: 6f 2d 64 6f 74 0a 09 09 09 20 20 20 20 20 31 0a  o-dot....     1.
9980: 09 09 09 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e  ...     (dcommon
9990: 3a 65 73 74 69 6d 61 74 65 2d 73 63 61 6c 65 20  :estimate-scale 
99a0: 73 69 7a 65 78 20 73 69 7a 65 79 20 6f 72 69 67  sizex sizey orig
99b0: 69 6e 78 20 6f 72 69 67 69 6e 79 20 64 6f 74 2d  inx originy dot-
99c0: 64 61 74 61 29 29 29 0a 09 20 28 73 6f 72 74 65  data))).. (sorte
99d0: 64 2d 74 65 73 74 6e 61 6d 65 73 20 28 69 66 20  d-testnames (if 
99e0: 6e 6f 2d 64 6f 74 0a 09 09 09 20 20 20 20 20 20  no-dot....      
99f0: 20 28 73 6f 72 74 20 73 6f 72 74 65 64 2d 74 65   (sort sorted-te
9a00: 73 74 6e 61 6d 65 73 20 73 74 72 69 6e 67 3e 3d  stnames string>=
9a10: 3f 29 0a 09 09 09 20 20 20 20 20 20 20 73 6f 72  ?)....       sor
9a20: 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 29 29 0a  ted-testnames)).
9a30: 09 20 28 63 75 72 72 2d 78 20 20 20 20 20 20 20  . (curr-x       
9a40: 20 20 30 29 20 20 3b 3b 20 4e 42 2f 2f 20 4e 4f    0)  ;; NB// NO
9a50: 54 20 73 63 72 65 65 6e 20 75 6e 69 74 73 0a 09  T screen units..
9a60: 20 28 63 75 72 72 2d 79 20 20 20 20 20 20 20 20   (curr-y        
9a70: 20 28 2f 20 28 2d 20 73 69 7a 65 79 20 62 6f 78   (/ (- sizey box
9a80: 68 20 6d 61 72 67 69 6e 29 20 73 63 61 6c 65 66  h margin) scalef
9a90: 29 29 20 3b 3b 20 75 73 65 64 20 77 68 65 6e 20  )) ;; used when 
9aa0: 6e 6f 2d 64 6f 74 0a 09 20 28 73 63 61 6c 65 64  no-dot.. (scaled
9ab0: 2d 73 69 7a 65 78 20 20 20 28 2f 20 73 69 7a 65  -sizex   (/ size
9ac0: 78 20 73 63 61 6c 65 66 29 29 29 0a 0a 20 20 20  x scalef)))..   
9ad0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74   (hash-table-set
9ae0: 21 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61  ! tests-draw-sta
9af0: 74 65 20 27 73 63 61 6c 65 66 20 73 63 61 6c 65  te 'scalef scale
9b00: 66 29 0a 20 20 20 20 0a 20 20 20 20 28 6c 65 74  f).    .    (let
9b10: 20 28 28 6c 6f 6e 67 65 73 74 2d 73 74 72 20 20   ((longest-str  
9b20: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 6f 72 74   (if (null? sort
9b30: 65 64 2d 74 65 73 74 6e 61 6d 65 73 29 20 22 20  ed-testnames) " 
9b40: 20 20 20 20 20 20 20 20 22 20 28 63 61 72 20 28          " (car (
9b50: 73 6f 72 74 20 73 6f 72 74 65 64 2d 74 65 73 74  sort sorted-test
9b60: 6e 61 6d 65 73 20 28 6c 61 6d 62 64 61 20 28 61  names (lambda (a
9b70: 20 62 29 28 3e 3d 20 28 73 74 72 69 6e 67 2d 6c   b)(>= (string-l
9b80: 65 6e 67 74 68 20 61 29 28 73 74 72 69 6e 67 2d  ength a)(string-
9b90: 6c 65 6e 67 74 68 20 62 29 29 29 29 29 29 29 29  length b))))))))
9ba0: 0a 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75  .      (let-valu
9bb0: 65 73 20 28 28 28 78 2d 6d 61 78 20 79 2d 6d 61  es (((x-max y-ma
9bc0: 78 29 20 28 63 61 6e 76 61 73 2d 74 65 78 74 2d  x) (canvas-text-
9bd0: 73 69 7a 65 20 63 6e 76 20 6c 6f 6e 67 65 73 74  size cnv longest
9be0: 2d 73 74 72 29 29 29 0a 09 28 69 66 20 28 3e 20  -str)))..(if (> 
9bf0: 78 2d 6d 61 78 20 62 6f 78 77 29 28 73 65 74 21  x-max boxw)(set!
9c00: 20 62 6f 78 77 20 28 2b 20 31 30 20 78 2d 6d 61   boxw (+ 10 x-ma
9c10: 78 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 70  x))))).    ;; (p
9c20: 72 69 6e 74 20 22 73 69 7a 65 78 3a 20 22 20 73  rint "sizex: " s
9c30: 69 7a 65 78 20 22 20 73 69 7a 65 79 3a 20 22 20  izex " sizey: " 
9c40: 73 69 7a 65 79 20 22 20 66 6f 6e 74 3a 20 22 20  sizey " font: " 
9c50: 28 63 61 6e 76 61 73 2d 66 6f 6e 74 20 63 6e 76  (canvas-font cnv
9c60: 29 20 22 20 6f 72 69 67 69 6e 78 3a 20 22 20 6f  ) " originx: " o
9c70: 72 69 67 69 6e 78 20 22 20 6f 72 69 67 69 6e 79  riginx " originy
9c80: 3a 20 22 20 6f 72 69 67 69 6e 79 20 22 20 78 74  : " originy " xt
9c90: 6f 72 69 67 3a 20 22 20 78 74 6f 72 69 67 20 22  orig: " xtorig "
9ca0: 20 79 74 6f 72 69 67 3a 20 22 20 79 74 6f 72 69   ytorig: " ytori
9cb0: 67 20 22 20 78 61 64 6a 3a 20 22 20 78 61 64 6a  g " xadj: " xadj
9cc0: 20 22 20 79 61 64 6a 3a 20 22 20 79 61 64 6a 29   " yadj: " yadj)
9cd0: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e  .    (if (not (n
9ce0: 75 6c 6c 3f 20 73 6f 72 74 65 64 2d 74 65 73 74  ull? sorted-test
9cf0: 6e 61 6d 65 73 29 29 0a 09 28 6c 65 74 20 6c 6f  names))..(let lo
9d00: 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 28 72  op ((hed (car (r
9d10: 65 76 65 72 73 65 20 73 6f 72 74 65 64 2d 74 65  everse sorted-te
9d20: 73 74 6e 61 6d 65 73 29 29 29 0a 09 09 20 20 20  stnames)))...   
9d30: 28 74 61 6c 20 28 63 64 72 20 28 72 65 76 65 72  (tal (cdr (rever
9d40: 73 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61  se sorted-testna
9d50: 6d 65 73 29 29 29 29 0a 09 20 20 28 6c 65 74 2a  mes))))..  (let*
9d60: 20 28 28 6e 6f 64 65 64 61 74 20 28 69 66 20 6e   ((nodedat (if n
9d70: 6f 2d 64 6f 74 0a 09 09 09 20 20 20 20 20 20 23  o-dot....      #
9d80: 66 0a 09 09 09 20 20 20 20 20 20 28 6c 65 74 20  f....      (let 
9d90: 28 28 74 6d 70 72 65 73 20 28 66 69 6c 74 65 72  ((tmpres (filter
9da0: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09   (lambda (x)....
9db0: 09 09 09 20 20 20 20 20 20 28 69 66 20 28 61 6e  ...      (if (an
9dc0: 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 78 29  d (not (null? x)
9dd0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20  )........       
9de0: 28 65 71 75 61 6c 3f 20 28 63 61 72 20 78 29 20  (equal? (car x) 
9df0: 22 6e 6f 64 65 22 29 29 0a 09 09 09 09 09 09 09  "node"))........
9e00: 20 20 28 65 71 75 61 6c 3f 20 68 65 64 20 28 63    (equal? hed (c
9e10: 61 64 72 20 78 29 29 0a 09 09 09 09 09 09 09 20  adr x))........ 
9e20: 20 23 66 29 29 0a 09 09 09 09 09 09 20 20 20 20   #f)).......    
9e30: 64 6f 74 2d 64 61 74 61 29 29 29 0a 09 09 09 09  dot-data))).....
9e40: 28 69 66 20 28 6e 75 6c 6c 3f 20 74 6d 70 72 65  (if (null? tmpre
9e50: 73 29 0a 09 09 09 09 20 20 20 20 3b 3b 20 20 20  s).....    ;;   
9e60: 20 20 20 20 20 20 20 20 6c 6c 78 20 20 6c 6c 79          llx  lly
9e70: 20 62 6f 78 77 20 62 6f 78 68 0a 09 09 09 09 20   boxw boxh..... 
9e80: 20 20 20 28 6c 69 73 74 20 22 30 22 20 22 31 22     (list "0" "1"
9e90: 20 22 31 22 20 28 63 6f 6e 63 20 28 6c 65 6e 67   "1" (conc (leng
9ea0: 74 68 20 74 61 6c 29 29 20 22 32 22 20 22 30 2e  th tal)) "2" "0.
9eb0: 35 22 29 20 3b 3b 20 72 65 74 75 72 6e 20 73 6f  5") ;; return so
9ec0: 6d 65 20 70 6c 61 63 65 68 6f 6c 64 65 72 20 6a  me placeholder j
9ed0: 75 6e 6b 20 69 66 20 6e 6f 20 64 61 74 20 66 6f  unk if no dat fo
9ee0: 75 6e 64 0a 09 09 09 09 20 20 20 20 28 63 61 72  und.....    (car
9ef0: 20 74 6d 70 72 65 73 29 29 29 29 29 0a 09 09 20   tmpres)))))... 
9f00: 28 65 64 67 65 64 61 74 20 28 69 66 20 6e 6f 2d  (edgedat (if no-
9f10: 64 6f 74 0a 09 09 09 20 20 20 20 20 20 27 28 29  dot....      '()
9f20: 0a 09 09 09 20 20 20 20 20 20 28 6c 65 74 20 28  ....      (let (
9f30: 28 65 64 67 65 73 20 28 66 69 6c 74 65 72 20 28  (edges (filter (
9f40: 6c 61 6d 62 64 61 20 28 78 29 20 20 3b 3b 20 66  lambda (x)  ;; f
9f50: 69 6c 74 65 72 20 66 6f 72 20 65 64 67 65 0a 09  ilter for edge..
9f60: 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 61  .....     (if (a
9f70: 6e 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 78  nd (not (null? x
9f80: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20  ))........      
9f90: 28 65 71 75 61 6c 3f 20 28 63 61 72 20 78 29 20  (equal? (car x) 
9fa0: 22 65 64 67 65 22 29 29 0a 09 09 09 09 09 09 09  "edge"))........
9fb0: 20 28 65 71 75 61 6c 3f 20 68 65 64 20 28 63 61   (equal? hed (ca
9fc0: 64 72 20 78 29 29 0a 09 09 09 09 09 09 09 20 23  dr x))........ #
9fd0: 66 29 29 0a 09 09 09 09 09 09 20 20 20 64 6f 74  f)).......   dot
9fe0: 2d 64 61 74 61 29 29 29 0a 09 09 09 09 28 6d 61  -data))).....(ma
9ff0: 70 20 28 6c 61 6d 62 64 61 20 28 69 6e 6c 73 74  p (lambda (inlst
a000: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 64 63  ).....       (dc
a010: 6f 6d 6d 6f 6e 3a 70 72 6f 63 65 73 73 2d 70 6f  ommon:process-po
a020: 6c 79 6c 69 6e 65 20 0a 09 09 09 09 09 28 6d 61  lyline ......(ma
a030: 70 20 28 6c 61 6d 62 64 61 20 28 69 6e 73 74 72  p (lambda (instr
a040: 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 73  )......       (s
a050: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 69 6e  tring->number in
a060: 73 74 72 29 29 20 3b 3b 20 63 6f 6e 76 65 72 74  str)) ;; convert
a070: 20 74 6f 20 6e 75 6d 62 65 72 20 61 6e 64 20 73   to number and s
a080: 63 61 6c 65 0a 09 09 09 09 09 20 20 20 20 20 28  cale......     (
a090: 6c 65 74 20 28 28 69 6c 20 28 63 64 64 64 64 72  let ((il (cddddr
a0a0: 20 69 6e 6c 73 74 29 29 29 0a 09 09 09 09 09 20   inlst)))...... 
a0b0: 20 20 20 20 20 20 28 74 61 6b 65 20 69 6c 20 28        (take il (
a0c0: 2d 20 28 6c 65 6e 67 74 68 20 69 6c 29 20 32 29  - (length il) 2)
a0d0: 29 29 29 0a 09 09 09 09 09 28 6c 61 6d 62 64 61  )))......(lambda
a0e0: 20 28 78 20 79 29 0a 09 09 09 09 09 20 20 28 6c   (x y)......  (l
a0f0: 69 73 74 20 28 2b 20 78 20 30 29 20 20 20 3b 3b  ist (+ x 0)   ;;
a100: 20 78 74 6f 72 69 67 29 0a 09 09 09 09 09 09 28   xtorig).......(
a110: 2b 20 79 20 30 29 29 29 20 3b 3b 20 79 74 6f 72  + y 0))) ;; ytor
a120: 69 67 29 29 29 0a 09 09 09 09 09 23 66 20 23 66  ig)))......#f #f
a130: 29 29 20 3b 3b 20 70 72 6f 63 65 73 73 20 70 6f  )) ;; process po
a140: 6c 79 6c 69 6e 65 0a 09 09 09 09 20 20 20 20 20  lyline.....     
a150: 65 64 67 65 73 29 29 29 29 0a 09 09 20 28 63 78  edges))))... (cx
a160: 20 20 20 28 69 66 20 6e 6f 2d 64 6f 74 20 3b 3b     (if no-dot ;;
a170: 20 74 68 69 73 20 69 73 20 74 68 65 20 63 65 6e   this is the cen
a180: 74 65 72 70 6f 69 6e 74 21 0a 09 09 09 20 20 20  terpoint!....   
a190: 63 75 72 72 2d 78 0a 09 09 09 20 20 20 28 73 74  curr-x....   (st
a1a0: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6c 69  ring->number (li
a1b0: 73 74 2d 72 65 66 20 6e 6f 64 65 64 61 74 20 32  st-ref nodedat 2
a1c0: 29 29 29 29 0a 09 09 20 28 63 79 20 20 20 28 69  ))))... (cy   (i
a1d0: 66 20 6e 6f 2d 64 6f 74 0a 09 09 09 20 20 20 63  f no-dot....   c
a1e0: 75 72 72 2d 79 0a 09 09 09 20 20 20 28 73 74 72  urr-y....   (str
a1f0: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6c 69 73  ing->number (lis
a200: 74 2d 72 65 66 20 6e 6f 64 65 64 61 74 20 33 29  t-ref nodedat 3)
a210: 29 29 29 0a 09 09 20 28 62 6f 78 77 20 28 69 66  )))... (boxw (if
a220: 20 6e 6f 2d 64 6f 74 0a 09 09 09 20 20 20 62 6f   no-dot....   bo
a230: 78 77 0a 09 09 09 20 20 20 28 73 74 72 69 6e 67  xw....   (string
a240: 2d 3e 6e 75 6d 62 65 72 20 28 6c 69 73 74 2d 72  ->number (list-r
a250: 65 66 20 6e 6f 64 65 64 61 74 20 34 29 29 29 29  ef nodedat 4))))
a260: 0a 09 09 20 28 62 6f 78 68 20 28 69 66 20 6e 6f  ... (boxh (if no
a270: 2d 64 6f 74 0a 09 09 09 20 20 20 62 6f 78 68 0a  -dot....   boxh.
a280: 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e  ...   (string->n
a290: 75 6d 62 65 72 20 28 6c 69 73 74 2d 72 65 66 20  umber (list-ref 
a2a0: 6e 6f 64 65 64 61 74 20 35 29 29 29 29 0a 09 09  nodedat 5))))...
a2b0: 20 28 62 6f 78 77 2f 32 20 20 28 2f 20 62 6f 78   (boxw/2  (/ box
a2c0: 77 20 32 29 29 0a 09 09 20 28 62 6f 78 68 2f 32  w 2))... (boxh/2
a2d0: 20 20 28 2f 20 62 6f 78 68 20 32 29 29 0a 09 09    (/ boxh 2))...
a2e0: 20 28 75 72 78 20 20 20 20 20 28 2b 20 63 78 20   (urx     (+ cx 
a2f0: 62 6f 78 77 2f 32 29 29 0a 09 09 20 28 75 72 79  boxw/2))... (ury
a300: 20 20 20 20 20 28 2b 20 63 79 20 62 6f 78 68 2f       (+ cy boxh/
a310: 32 29 29 0a 09 09 20 28 6c 6c 78 20 20 20 20 20  2))... (llx     
a320: 28 2d 20 63 78 20 62 6f 78 77 2f 32 29 29 0a 09  (- cx boxw/2))..
a330: 09 20 28 6c 6c 79 20 20 20 20 20 28 2d 20 63 79  . (lly     (- cy
a340: 20 62 6f 78 68 2f 32 29 29 29 0a 0a 09 20 20 20   boxh/2)))...   
a350: 20 3b 3b 20 69 66 20 77 65 20 61 72 65 20 69 6e   ;; if we are in
a360: 20 6e 6f 2d 64 6f 74 20 6d 6f 64 65 20 74 68 65   no-dot mode the
a370: 6e 20 69 6e 63 72 65 6d 65 6e 74 20 63 75 72 72  n increment curr
a380: 2d 78 20 61 6e 64 20 63 75 72 72 2d 79 20 61 73  -x and curr-y as
a390: 20 6e 65 65 64 65 64 0a 09 20 20 20 20 28 69 66   needed..    (if
a3a0: 20 6e 6f 2d 64 6f 74 0a 09 09 28 62 65 67 69 6e   no-dot...(begin
a3b0: 0a 09 09 20 20 28 63 6f 6e 64 20 0a 09 09 20 20  ...  (cond ...  
a3c0: 20 28 28 3c 20 63 75 72 72 2d 78 20 28 2d 20 73   ((< curr-x (- s
a3d0: 63 61 6c 65 64 2d 73 69 7a 65 78 20 62 6f 78 77  caled-sizex boxw
a3e0: 20 62 6f 78 77 20 6d 61 72 67 69 6e 29 29 0a 09   boxw margin))..
a3f0: 09 20 20 20 20 28 73 65 74 21 20 63 75 72 72 2d  .    (set! curr-
a400: 78 20 28 2b 20 63 75 72 72 2d 78 20 62 6f 78 77  x (+ curr-x boxw
a410: 20 6d 61 72 67 69 6e 29 29 29 0a 09 09 20 20 20   margin)))...   
a420: 28 28 3e 20 63 75 72 72 2d 78 20 28 2d 20 73 63  ((> curr-x (- sc
a430: 61 6c 65 64 2d 73 69 7a 65 78 20 62 6f 78 77 20  aled-sizex boxw 
a440: 62 6f 78 77 20 6d 61 72 67 69 6e 29 29 0a 09 09  boxw margin))...
a450: 20 20 20 20 28 73 65 74 21 20 63 75 72 72 2d 78      (set! curr-x
a460: 20 30 29 0a 09 09 20 20 20 20 28 73 65 74 21 20   0)...    (set! 
a470: 63 75 72 72 2d 79 20 28 2d 20 63 75 72 72 2d 79  curr-y (- curr-y
a480: 20 28 2b 20 62 6f 78 68 20 6d 61 72 67 69 6e 29   (+ boxh margin)
a490: 29 29 29 29 29 29 0a 09 09 09 09 09 3b 20 28 70  ))))))......; (p
a4a0: 72 69 6e 74 20 22 68 65 64 20 22 20 68 65 64 20  rint "hed " hed 
a4b0: 22 20 6c 6c 78 20 22 20 6c 6c 78 20 22 20 6c 6c  " llx " llx " ll
a4c0: 79 20 22 20 6c 6c 79 20 22 20 75 72 78 20 22 20  y " lly " urx " 
a4d0: 75 72 78 20 22 20 75 72 79 20 22 20 75 72 79 29  urx " ury " ury)
a4e0: 0a 09 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 64  ..    (dcommon:d
a4f0: 72 61 77 2d 74 65 73 74 20 63 6e 76 20 78 6f 66  raw-test cnv xof
a500: 66 73 65 74 20 79 6f 66 66 73 65 74 20 73 63 61  fset yoffset sca
a510: 6c 65 66 20 6c 6c 78 20 6c 6c 79 20 62 6f 78 77  lef llx lly boxw
a520: 20 62 6f 78 68 20 68 65 64 20 28 68 61 73 68 2d   boxh hed (hash-
a530: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c  table-ref/defaul
a540: 74 20 73 65 6c 65 63 74 65 64 2d 74 65 73 74 73  t selected-tests
a550: 20 68 65 64 20 23 66 29 29 0a 09 20 20 20 20 3b   hed #f))..    ;
a560: 3b 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d  ; (dcommon:draw-
a570: 61 72 72 6f 77 73 20 63 6e 76 20 74 65 73 74 6e  arrows cnv testn
a580: 61 6d 65 20 74 65 73 74 73 2d 69 6e 66 6f 20 74  ame tests-info t
a590: 65 73 74 2d 72 65 63 6f 72 64 73 29 29 0a 09 20  est-records)).. 
a5a0: 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77     (dcommon:draw
a5b0: 2d 65 64 67 65 73 20 63 6e 76 20 78 6f 66 66 73  -edges cnv xoffs
a5c0: 65 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c 65  et yoffset scale
a5d0: 66 20 65 64 67 65 64 61 74 29 0a 09 20 20 20 20  f edgedat)..    
a5e0: 0a 09 20 20 20 20 3b 3b 20 64 61 74 61 20 75 73  ..    ;; data us
a5f0: 65 64 20 62 79 20 6d 6f 75 73 65 20 63 6c 69 63  ed by mouse clic
a600: 6b 20 63 61 6c 63 2e 20 6b 65 65 70 20 74 68 65  k calc. keep the
a610: 20 77 61 63 6b 79 20 6f 72 64 65 72 20 66 6f 72   wacky order for
a620: 20 6e 6f 77 2e 0a 09 20 20 20 20 28 68 61 73 68   now...    (hash
a630: 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74  -table-set! test
a640: 73 2d 69 6e 66 6f 20 68 65 64 20 20 28 6c 69 73  s-info hed  (lis
a650: 74 20 6c 6c 78 20 6c 6c 79 20 75 72 78 20 75 72  t llx lly urx ur
a660: 79 20 62 6f 78 77 20 62 6f 78 68 20 65 64 67 65  y boxw boxh edge
a670: 64 61 74 29 29 20 0a 09 20 20 20 20 28 69 66 20  dat)) ..    (if 
a680: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29  (not (null? tal)
a690: 29 0a 09 09 28 6c 6f 6f 70 20 28 63 61 72 20 74  )...(loop (car t
a6a0: 61 6c 29 0a 09 09 20 20 20 20 20 20 28 63 64 72  al)...      (cdr
a6b0: 20 74 61 6c 29 29 29 29 29 29 0a 20 20 20 20 29   tal)))))).    )
a6c0: 29 0a 0a 3b 3b 20 70 65 72 2d 70 6f 69 6e 74 2d  )..;; per-point-
a6d0: 70 72 6f 63 20 72 65 71 75 69 72 65 64 2c 20 72  proc required, r
a6e0: 65 6d 61 69 6e 64 65 72 20 6f 70 74 69 6f 6e 61  emainder optiona
a6f0: 6c 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 63  l.;;.(define (dc
a700: 6f 6d 6d 6f 6e 3a 70 72 6f 63 65 73 73 2d 70 6f  ommon:process-po
a710: 6c 79 6c 69 6e 65 20 6c 69 6e 65 20 70 65 72 2d  lyline line per-
a720: 70 6f 69 6e 74 2d 70 72 6f 63 20 70 65 72 2d 73  point-proc per-s
a730: 65 67 6d 65 6e 74 2d 70 72 6f 63 20 6c 61 73 74  egment-proc last
a740: 2d 73 65 67 6d 65 6e 74 2d 70 72 6f 63 29 0a 20  -segment-proc). 
a750: 20 28 69 66 20 28 3c 20 28 6c 65 6e 67 74 68 20   (if (< (length 
a760: 6c 69 6e 65 29 20 32 29 0a 20 20 20 20 20 20 27  line) 2).      '
a770: 28 29 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f  ().      (let lo
a780: 6f 70 20 28 28 78 31 20 20 20 28 63 61 72 20 20  op ((x1   (car  
a790: 6c 69 6e 65 29 29 0a 09 09 20 28 79 31 20 20 20  line))... (y1   
a7a0: 28 63 61 64 72 20 6c 69 6e 65 29 29 0a 09 09 20  (cadr line))... 
a7b0: 28 78 32 20 20 20 23 66 29 0a 09 09 20 28 79 32  (x2   #f)... (y2
a7c0: 20 20 20 23 66 29 0a 09 09 20 28 74 61 6c 20 20     #f)... (tal  
a7d0: 28 63 64 64 72 20 6c 69 6e 65 29 29 0a 09 09 20  (cddr line))... 
a7e0: 28 72 65 73 20 20 27 28 29 29 29 0a 09 28 69 66  (res  '()))..(if
a7f0: 20 28 61 6e 64 20 78 31 20 79 31 20 78 32 20 79   (and x1 y1 x2 y
a800: 32 20 70 65 72 2d 73 65 67 6d 65 6e 74 2d 70 72  2 per-segment-pr
a810: 6f 63 29 0a 09 20 20 20 20 28 70 65 72 2d 73 65  oc)..    (per-se
a820: 67 6d 65 6e 74 2d 70 72 6f 63 20 78 31 20 79 31  gment-proc x1 y1
a830: 20 78 32 20 79 32 29 29 0a 09 28 69 66 20 28 3c   x2 y2))..(if (<
a840: 20 28 6c 65 6e 67 74 68 20 74 61 6c 29 20 32 29   (length tal) 2)
a850: 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20  ..    (begin..  
a860: 20 20 20 20 28 69 66 20 6c 61 73 74 2d 73 65 67      (if last-seg
a870: 6d 65 6e 74 2d 70 72 6f 63 20 28 6c 61 73 74 2d  ment-proc (last-
a880: 73 65 67 6d 65 6e 74 2d 70 72 6f 63 20 78 31 20  segment-proc x1 
a890: 79 31 20 78 32 20 79 32 29 29 0a 09 20 20 20 20  y1 x2 y2))..    
a8a0: 20 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 70    (append res (p
a8b0: 65 72 2d 70 6f 69 6e 74 2d 70 72 6f 63 20 78 31  er-point-proc x1
a8c0: 20 79 31 29 29 29 0a 09 20 20 20 20 28 6c 6f 6f   y1)))..    (loo
a8d0: 70 20 28 63 61 72 20 74 61 6c 29 28 63 61 64 72  p (car tal)(cadr
a8e0: 20 74 61 6c 29 20 78 31 20 79 31 20 28 63 64 64   tal) x1 y1 (cdd
a8f0: 72 20 74 61 6c 29 20 28 61 70 70 65 6e 64 20 72  r tal) (append r
a900: 65 73 20 28 70 65 72 2d 70 6f 69 6e 74 2d 70 72  es (per-point-pr
a910: 6f 63 20 78 31 20 79 31 29 29 29 29 29 29 29 0a  oc x1 y1))))))).
a920: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f  .(define (dcommo
a930: 6e 3a 72 65 64 72 61 77 2d 74 65 73 74 73 20 63  n:redraw-tests c
a940: 6e 76 20 78 61 64 6a 20 79 61 64 6a 20 73 69 7a  nv xadj yadj siz
a950: 65 78 20 73 69 7a 65 79 20 73 69 7a 65 78 6d 6d  ex sizey sizexmm
a960: 20 73 69 7a 65 79 6d 6d 20 6f 72 69 67 69 6e 78   sizeymm originx
a970: 20 6f 72 69 67 69 6e 79 20 74 65 73 74 73 2d 64   originy tests-d
a980: 72 61 77 2d 73 74 61 74 65 20 73 6f 72 74 65 64  raw-state sorted
a990: 2d 74 65 73 74 6e 61 6d 65 73 20 74 65 73 74 2d  -testnames test-
a9a0: 72 65 63 6f 72 64 73 29 0a 20 20 28 6c 65 74 2a  records).  (let*
a9b0: 20 28 28 73 63 61 6c 65 66 20 20 20 20 20 20 20   ((scalef       
a9c0: 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62         (hash-tab
a9d0: 6c 65 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61  le-ref tests-dra
a9e0: 77 2d 73 74 61 74 65 20 27 73 63 61 6c 65 66 29  w-state 'scalef)
a9f0: 29 0a 09 20 28 78 6f 66 66 73 65 74 20 20 20 20  ).. (xoffset    
aa00: 20 20 20 20 20 20 20 20 20 28 64 63 6f 6d 6d 6f           (dcommo
aa10: 6e 3a 67 65 74 2d 78 6f 66 66 73 65 74 20 74 65  n:get-xoffset te
aa20: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 73  sts-draw-state s
aa30: 69 7a 65 78 20 78 61 64 6a 29 29 0a 09 20 28 79  izex xadj)).. (y
aa40: 6f 66 66 73 65 74 20 20 20 20 20 20 20 20 20 20  offset          
aa50: 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d     (dcommon:get-
aa60: 79 6f 66 66 73 65 74 20 74 65 73 74 73 2d 64 72  yoffset tests-dr
aa70: 61 77 2d 73 74 61 74 65 20 73 69 7a 65 79 20 79  aw-state sizey y
aa80: 61 64 6a 29 29 0a 09 20 28 74 65 73 74 73 2d 69  adj)).. (tests-i
aa90: 6e 66 6f 20 20 20 20 20 20 20 20 20 20 28 68 61  nfo          (ha
aaa0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73  sh-table-ref tes
aab0: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 74  ts-draw-state 't
aac0: 65 73 74 73 2d 69 6e 66 6f 29 29 0a 09 20 28 73  ests-info)).. (s
aad0: 65 6c 65 63 74 65 64 2d 74 65 73 74 73 20 20 20  elected-tests   
aae0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72     (hash-table-r
aaf0: 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74  ef tests-draw-st
ab00: 61 74 65 20 27 73 65 6c 65 63 74 65 64 2d 74 65  ate 'selected-te
ab10: 73 74 73 20 29 29 29 0a 20 20 20 20 28 69 66 20  sts ))).    (if 
ab20: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 73 6f 72 74  (not (null? sort
ab30: 65 64 2d 74 65 73 74 6e 61 6d 65 73 29 29 0a 09  ed-testnames))..
ab40: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20  (let loop ((hed 
ab50: 28 63 61 72 20 28 72 65 76 65 72 73 65 20 73 6f  (car (reverse so
ab60: 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 29 29  rted-testnames))
ab70: 29 0a 09 09 20 20 20 28 74 61 6c 20 28 63 64 72  )...   (tal (cdr
ab80: 20 28 72 65 76 65 72 73 65 20 73 6f 72 74 65 64   (reverse sorted
ab90: 2d 74 65 73 74 6e 61 6d 65 73 29 29 29 29 0a 09  -testnames))))..
aba0: 20 20 28 6c 65 74 2a 20 28 28 74 76 61 6c 73 20    (let* ((tvals 
abb0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20  (hash-table-ref 
abc0: 74 65 73 74 73 2d 69 6e 66 6f 20 68 65 64 29 29  tests-info hed))
abd0: 0a 09 09 20 28 6c 6c 78 20 20 20 28 6c 69 73 74  ... (llx   (list
abe0: 2d 72 65 66 20 74 76 61 6c 73 20 30 29 29 0a 09  -ref tvals 0))..
abf0: 09 20 28 6c 6c 79 20 20 20 28 6c 69 73 74 2d 72  . (lly   (list-r
ac00: 65 66 20 74 76 61 6c 73 20 31 29 29 0a 09 09 20  ef tvals 1))... 
ac10: 28 62 6f 78 77 20 20 28 6c 69 73 74 2d 72 65 66  (boxw  (list-ref
ac20: 20 74 76 61 6c 73 20 34 29 29 0a 09 09 20 28 62   tvals 4))... (b
ac30: 6f 78 68 20 20 28 6c 69 73 74 2d 72 65 66 20 74  oxh  (list-ref t
ac40: 76 61 6c 73 20 35 29 29 0a 09 09 20 28 65 64 67  vals 5))... (edg
ac50: 65 73 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20  es (map (lambda 
ac60: 28 70 6c 69 6e 65 29 0a 09 09 09 20 20 20 20 20  (pline)....     
ac70: 20 20 28 64 63 6f 6d 6d 6f 6e 3a 70 72 6f 63 65    (dcommon:proce
ac80: 73 73 2d 70 6f 6c 79 6c 69 6e 65 20 70 6c 69 6e  ss-polyline plin
ac90: 65 0a 09 09 09 09 09 09 09 20 28 6c 61 6d 62 64  e........ (lambd
aca0: 61 20 28 78 31 20 79 31 29 0a 09 09 09 09 09 09  a (x1 y1).......
acb0: 09 20 20 20 28 6c 69 73 74 20 78 31 20 79 31 29  .   (list x1 y1)
acc0: 29 0a 09 09 09 09 09 09 09 20 23 66 20 23 66 29  )........ #f #f)
acd0: 29 0a 09 09 09 20 20 20 20 20 28 6c 69 73 74 2d  )....     (list-
ace0: 72 65 66 20 74 76 61 6c 73 20 36 29 29 29 0a 09  ref tvals 6)))..
acf0: 09 20 28 75 72 78 20 20 20 28 2b 20 6c 6c 78 20  . (urx   (+ llx 
ad00: 62 6f 78 77 29 29 0a 09 09 20 28 75 72 79 20 20  boxw))... (ury  
ad10: 20 28 2b 20 6c 6c 79 20 62 6f 78 68 29 29 29 0a   (+ lly boxh))).
ad20: 09 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72  .    (dcommon:dr
ad30: 61 77 2d 74 65 73 74 20 63 6e 76 20 78 6f 66 66  aw-test cnv xoff
ad40: 73 65 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c  set yoffset scal
ad50: 65 66 20 6c 6c 78 20 6c 6c 79 20 62 6f 78 77 20  ef llx lly boxw 
ad60: 62 6f 78 68 20 68 65 64 20 28 68 61 73 68 2d 74  boxh hed (hash-t
ad70: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74  able-ref/default
ad80: 20 73 65 6c 65 63 74 65 64 2d 74 65 73 74 73 20   selected-tests 
ad90: 68 65 64 20 23 66 29 29 0a 09 20 20 20 20 28 64  hed #f))..    (d
ada0: 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 65 64 67 65  common:draw-edge
adb0: 73 20 63 6e 76 20 78 6f 66 66 73 65 74 20 79 6f  s cnv xoffset yo
adc0: 66 66 73 65 74 20 73 63 61 6c 65 66 20 65 64 67  ffset scalef edg
add0: 65 73 29 0a 09 20 20 20 20 28 69 66 20 28 6e 6f  es)..    (if (no
ade0: 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 0a 09  t (null? tal))..
adf0: 09 3b 3b 20 6c 65 61 76 65 20 61 20 63 6f 6c 75  .;; leave a colu
ae00: 6d 6e 20 6f 66 20 73 70 61 63 65 20 74 6f 20 74  mn of space to t
ae10: 68 65 20 72 69 67 68 74 20 74 6f 20 6c 69 73 74  he right to list
ae20: 20 69 74 65 6d 73 0a 09 09 28 6c 6f 6f 70 20 28   items...(loop (
ae30: 63 61 72 20 74 61 6c 29 0a 09 09 20 20 20 20 20  car tal)...     
ae40: 20 28 63 64 72 20 74 61 6c 29 29 29 29 29 29 29   (cdr tal)))))))
ae50: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  )..;;===========
ae60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
ae70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
ae80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
ae90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52  ===========.;; R
aea0: 55 4e 20 43 4f 4e 54 52 4f 4c 53 0a 3b 3b 3d 3d  UN CONTROLS.;;==
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 3d 3d 3d 3d 3d 3d  ================
aed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
aee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
aef0: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64  ====..(define (d
af00: 63 6f 6d 6d 6f 6e 3a 63 6f 6d 6d 61 6e 64 2d 65  common:command-e
af10: 78 65 63 75 74 69 6f 6e 2d 63 6f 6e 74 72 6f 6c  xecution-control
af20: 20 64 61 74 61 29 0a 20 20 3b 3b 20 54 68 65 20   data).  ;; The 
af30: 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 64 69 73  command line dis
af40: 70 6c 61 79 2f 65 78 65 63 74 75 74 69 6f 6e 20  play/exectution 
af50: 63 6f 6e 74 72 6f 6c 0a 20 20 28 69 75 70 3a 66  control.  (iup:f
af60: 72 61 6d 65 0a 20 20 20 23 3a 74 69 74 6c 65 20  rame.   #:title 
af70: 22 43 6f 6d 6d 61 6e 64 20 74 6f 20 62 65 20 65  "Command to be e
af80: 78 65 63 74 75 74 65 64 22 0a 20 20 20 28 69 75  xectuted".   (iu
af90: 70 3a 68 62 6f 78 0a 20 20 20 20 28 69 75 70 3a  p:hbox.    (iup:
afa0: 6c 61 62 65 6c 20 22 52 75 6e 20 6f 6e 22 20 23  label "Run on" #
afb0: 3a 73 69 7a 65 20 22 34 30 78 22 29 0a 20 20 20  :size "40x").   
afc0: 20 28 69 75 70 3a 72 61 64 69 6f 20 0a 20 20 20   (iup:radio .   
afd0: 20 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20 20    (iup:hbox.    
afe0: 20 20 28 69 75 70 3a 74 6f 67 67 6c 65 20 22 4c    (iup:toggle "L
aff0: 6f 63 61 6c 22 20 23 3a 73 69 7a 65 20 22 34 30  ocal" #:size "40
b000: 78 22 29 0a 20 20 20 20 20 20 28 69 75 70 3a 74  x").      (iup:t
b010: 6f 67 67 6c 65 20 22 53 65 72 76 65 72 22 20 23  oggle "Server" #
b020: 3a 73 69 7a 65 20 22 34 30 78 22 29 29 29 0a 20  :size "40x"))). 
b030: 20 20 20 28 6c 65 74 20 28 28 74 62 20 28 69 75     (let ((tb (iu
b040: 70 3a 74 65 78 74 62 6f 78 20 0a 09 20 20 20 20  p:textbox ..    
b050: 20 20 20 23 3a 76 61 6c 75 65 20 22 6d 65 67 61     #:value "mega
b060: 74 65 73 74 20 22 0a 09 20 20 20 20 20 20 20 23  test "..       #
b070: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e  :expand "HORIZON
b080: 54 41 4c 22 0a 09 20 20 20 20 20 20 20 23 3a 72  TAL"..       #:r
b090: 65 61 64 6f 6e 6c 79 20 22 59 45 53 22 0a 09 20  eadonly "YES".. 
b0a0: 20 20 20 20 20 20 23 3a 66 6f 6e 74 20 22 43 6f        #:font "Co
b0b0: 75 72 69 65 72 20 4e 65 77 2c 20 2d 31 32 22 0a  urier New, -12".
b0c0: 09 20 20 20 20 20 20 20 29 29 29 0a 20 20 20 20  .       ))).    
b0d0: 20 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74    (dboard:tabdat
b0e0: 2d 63 6f 6d 6d 61 6e 64 2d 74 62 2d 73 65 74 21  -command-tb-set!
b0f0: 20 64 61 74 61 20 74 62 29 0a 20 20 20 20 20 20   data tb).      
b100: 74 62 29 0a 20 20 20 20 28 69 75 70 3a 62 75 74  tb).    (iup:but
b110: 74 6f 6e 20 22 45 78 65 63 75 74 65 22 20 23 3a  ton "Execute" #:
b120: 73 69 7a 65 20 22 35 30 78 22 0a 09 09 23 3a 61  size "50x"...#:a
b130: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f  ction (lambda (o
b140: 62 6a 29 0a 09 09 09 20 20 20 3b 3b 20 28 6c 65  bj)....   ;; (le
b150: 74 20 28 28 63 6d 64 20 28 63 6f 6e 63 20 3b 3b  t ((cmd (conc ;;
b160: 20 22 78 74 65 72 6d 20 2d 67 65 6f 6d 65 74 72   "xterm -geometr
b170: 79 20 31 38 30 78 32 30 20 2d 65 20 5c 22 22 0a  y 180x20 -e \"".
b180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
b190: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d             (comm
b1a0: 6f 6e 3a 72 75 6e 2d 61 2d 63 6f 6d 6d 61 6e 64  on:run-a-command
b1b0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20   (iup:attribute 
b1c0: 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 63  (dboard:tabdat-c
b1d0: 6f 6d 6d 61 6e 64 2d 74 62 20 64 61 74 61 29 20  ommand-tb data) 
b1e0: 22 56 41 4c 55 45 22 29 29 29 29 29 29 29 0a 20  "VALUE"))))))). 
b1f0: 20 20 20 3b 3b 20 22 3b 65 63 68 6f 20 50 72 65     ;; ";echo Pre
b200: 73 73 20 61 6e 79 20 6b 65 79 20 74 6f 20 63 6f  ss any key to co
b210: 6e 74 69 6e 75 65 3b 62 61 73 68 20 2d 63 20 27  ntinue;bash -c '
b220: 72 65 61 64 20 2d 6e 20 31 20 2d 73 27 5c 22 20  read -n 1 -s'\" 
b230: 26 22 29 29 29 0a 20 20 20 20 3b 3b 20 28 73 79  &"))).    ;; (sy
b240: 73 74 65 6d 20 63 6d 64 29 29 29 29 29 29 29 0a  stem cmd))))))).
b250: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f  .(define (dcommo
b260: 6e 3a 63 6f 6d 6d 61 6e 64 2d 61 63 74 69 6f 6e  n:command-action
b270: 2d 73 65 6c 65 63 74 6f 72 20 63 6f 6d 6d 6f 6e  -selector common
b280: 64 61 74 20 74 61 62 64 61 74 20 23 21 6b 65 79  dat tabdat #!key
b290: 20 28 74 61 62 2d 6e 75 6d 20 23 66 29 29 0a 20   (tab-num #f)). 
b2a0: 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 20 23   (iup:frame.   #
b2b0: 3a 74 69 74 6c 65 20 22 53 65 74 20 74 68 65 20  :title "Set the 
b2c0: 61 63 74 69 6f 6e 20 74 6f 20 74 61 6b 65 22 0a  action to take".
b2d0: 20 20 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20     (iup:hbox.   
b2e0: 20 3b 3b 20 28 69 75 70 3a 6c 61 62 65 6c 20 22   ;; (iup:label "
b2f0: 43 6f 6d 6d 61 6e 64 20 74 6f 20 72 75 6e 22 20  Command to run" 
b300: 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f  #:expand "HORIZO
b310: 4e 54 41 4c 22 20 23 3a 73 69 7a 65 20 22 37 30  NTAL" #:size "70
b320: 78 22 20 23 3a 61 6c 69 67 6e 6d 65 6e 74 20 22  x" #:alignment "
b330: 4c 45 46 54 3a 41 43 45 4e 54 45 52 22 29 0a 20  LEFT:ACENTER"). 
b340: 20 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 73 2d     (let* ((cmds-
b350: 6c 69 73 74 20 27 28 22 72 75 6e 22 20 22 72 65  list '("run" "re
b360: 6d 6f 76 65 2d 72 75 6e 73 22 29 29 20 3b 3b 20  move-runs")) ;; 
b370: 20 22 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74   "set-state-stat
b380: 75 73 22 20 22 6c 6f 63 6b 2d 72 75 6e 73 22 20  us" "lock-runs" 
b390: 22 75 6e 6c 6f 63 6b 2d 72 75 6e 73 22 29 29 0a  "unlock-runs")).
b3a0: 09 20 20 20 28 6c 62 20 20 20 20 20 20 20 20 20  .   (lb         
b3b0: 28 69 75 70 3a 6c 69 73 74 62 6f 78 20 23 3a 65  (iup:listbox #:e
b3c0: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41  xpand "HORIZONTA
b3d0: 4c 22 0a 09 09 09 09 20 20 20 20 23 3a 64 72 6f  L".....    #:dro
b3e0: 70 64 6f 77 6e 20 22 59 45 53 22 0a 09 09 09 09  pdown "YES".....
b3f0: 20 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61      #:action (la
b400: 6d 62 64 61 20 28 6f 62 6a 20 76 61 6c 20 69 6e  mbda (obj val in
b410: 64 65 78 20 6c 62 73 74 61 74 65 29 0a 09 09 09  dex lbstate)....
b420: 09 09 20 20 20 20 20 20 20 3b 3b 20 28 70 72 69  ..       ;; (pri
b430: 6e 74 20 6f 62 6a 20 22 20 22 20 76 61 6c 20 22  nt obj " " val "
b440: 20 22 20 69 6e 64 65 78 20 22 20 22 20 6c 62 73   " index " " lbs
b450: 74 61 74 65 29 0a 09 09 09 09 09 20 20 20 20 20  tate)......     
b460: 20 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74    (dboard:tabdat
b470: 2d 63 6f 6d 6d 61 6e 64 2d 73 65 74 21 20 74 61  -command-set! ta
b480: 62 64 61 74 20 76 61 6c 29 0a 09 09 09 09 09 20  bdat val)...... 
b490: 20 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 64        (dashboard
b4a0: 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d  :update-run-comm
b4b0: 61 6e 64 20 74 61 62 64 61 74 29 29 29 29 0a 09  and tabdat))))..
b4c0: 20 20 20 28 64 65 66 61 75 6c 74 2d 63 6d 64 20     (default-cmd 
b4d0: 28 63 61 72 20 63 6d 64 73 2d 6c 69 73 74 29 29  (car cmds-list))
b4e0: 29 0a 20 20 20 20 20 20 28 69 75 70 6c 69 73 74  ).      (iuplist
b4f0: 62 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62  box-fill-list lb
b500: 20 63 6d 64 73 2d 6c 69 73 74 20 73 65 6c 65 63   cmds-list selec
b510: 74 65 64 2d 69 74 65 6d 3a 20 64 65 66 61 75 6c  ted-item: defaul
b520: 74 2d 63 6d 64 29 0a 20 20 20 20 20 20 28 64 62  t-cmd).      (db
b530: 6f 61 72 64 3a 74 61 62 64 61 74 2d 63 6f 6d 6d  oard:tabdat-comm
b540: 61 6e 64 2d 73 65 74 21 20 74 61 62 64 61 74 20  and-set! tabdat 
b550: 64 65 66 61 75 6c 74 2d 63 6d 64 29 0a 20 20 20  default-cmd).   
b560: 20 20 20 6c 62 29 29 29 29 0a 0a 28 64 65 66 69     lb))))..(defi
b570: 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 63 6f 6d 6d  ne (dcommon:comm
b580: 61 6e 64 2d 72 75 6e 6e 61 6d 65 2d 73 65 6c 65  and-runname-sele
b590: 63 74 6f 72 20 63 6f 6d 6d 6f 6e 64 61 74 20 74  ctor commondat t
b5a0: 61 62 64 61 74 20 23 21 6b 65 79 20 28 74 61 62  abdat #!key (tab
b5b0: 2d 6e 75 6d 20 23 66 29 29 20 3b 3b 20 61 6c 6c  -num #f)) ;; all
b5c0: 64 61 74 20 64 61 74 61 29 0a 20 20 28 69 75 70  dat data).  (iup
b5d0: 3a 66 72 61 6d 65 0a 20 20 20 23 3a 74 69 74 6c  :frame.   #:titl
b5e0: 65 20 22 52 75 6e 6e 61 6d 65 22 0a 20 20 20 28  e "Runname".   (
b5f0: 6c 65 74 2a 20 28 28 64 65 66 61 75 6c 74 2d 72  let* ((default-r
b600: 75 6e 2d 6e 61 6d 65 20 28 73 65 63 6f 6e 64 73  un-name (seconds
b610: 2d 3e 77 6f 72 6b 2d 77 65 65 6b 2f 64 61 79 20  ->work-week/day 
b620: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73  (current-seconds
b630: 29 29 29 0a 09 20 20 28 74 62 20 28 69 75 70 3a  )))..  (tb (iup:
b640: 74 65 78 74 62 6f 78 20 23 3a 65 78 70 61 6e 64  textbox #:expand
b650: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09   "HORIZONTAL"...
b660: 09 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61  .   #:action (la
b670: 6d 62 64 61 20 28 6f 62 6a 20 76 61 6c 20 74 78  mbda (obj val tx
b680: 74 29 0a 09 09 09 09 20 20 20 20 20 20 28 64 65  t).....      (de
b690: 62 75 67 3a 63 61 74 63 68 2d 61 6e 64 2d 64 75  bug:catch-and-du
b6a0: 6d 70 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c  mp.....       (l
b6b0: 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 20 3b  ambda ()...... ;
b6c0: 3b 20 28 70 72 69 6e 74 20 22 6f 62 6a 3a 20 22  ; (print "obj: "
b6d0: 20 6f 62 6a 20 22 20 76 61 6c 3a 20 22 20 76 61   obj " val: " va
b6e0: 6c 20 22 20 75 6e 6b 3a 20 22 20 75 6e 6b 29 0a  l " unk: " unk).
b6f0: 09 09 09 09 09 20 28 64 62 6f 61 72 64 3a 74 61  ..... (dboard:ta
b700: 62 64 61 74 2d 72 75 6e 2d 6e 61 6d 65 2d 73 65  bdat-run-name-se
b710: 74 21 20 74 61 62 64 61 74 20 74 78 74 29 20 3b  t! tabdat txt) ;
b720: 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65  ; (iup:attribute
b730: 20 6f 62 6a 20 22 56 41 4c 55 45 22 29 29 0a 09   obj "VALUE"))..
b740: 09 09 09 09 20 28 64 61 73 68 62 6f 61 72 64 3a  .... (dashboard:
b750: 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61  update-run-comma
b760: 6e 64 20 74 61 62 64 61 74 29 29 0a 09 09 09 09  nd tabdat)).....
b770: 20 20 20 20 20 20 20 22 63 6f 6d 6d 61 6e 64 2d         "command-
b780: 72 75 6e 6e 61 6d 65 2d 73 65 6c 65 63 74 6f 72  runname-selector
b790: 20 74 62 20 61 63 74 69 6f 6e 22 29 29 0a 09 09   tb action"))...
b7a0: 09 20 20 20 23 3a 76 61 6c 75 65 20 28 6f 72 20  .   #:value (or 
b7b0: 64 65 66 61 75 6c 74 2d 72 75 6e 2d 6e 61 6d 65  default-run-name
b7c0: 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d   (dboard:tabdat-
b7d0: 72 75 6e 2d 6e 61 6d 65 20 74 61 62 64 61 74 29  run-name tabdat)
b7e0: 29 29 29 0a 09 20 20 28 6c 62 20 28 69 75 70 3a  )))..  (lb (iup:
b7f0: 6c 69 73 74 62 6f 78 20 23 3a 65 78 70 61 6e 64  listbox #:expand
b800: 20 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09   "HORIZONTAL"...
b810: 09 20 20 20 23 3a 64 72 6f 70 64 6f 77 6e 20 22  .   #:dropdown "
b820: 59 45 53 22 0a 09 09 09 20 20 20 23 3a 61 63 74  YES"....   #:act
b830: 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a  ion (lambda (obj
b840: 20 76 61 6c 20 69 6e 64 65 78 20 6c 62 73 74 61   val index lbsta
b850: 74 65 29 0a 09 09 09 09 20 20 20 20 20 20 28 64  te).....      (d
b860: 65 62 75 67 3a 63 61 74 63 68 2d 61 6e 64 2d 64  ebug:catch-and-d
b870: 75 6d 70 0a 09 09 09 09 20 20 20 20 20 20 20 28  ump.....       (
b880: 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 20  lambda ()...... 
b890: 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f  (if (not (equal?
b8a0: 20 76 61 6c 20 22 22 29 29 0a 09 09 09 09 09 20   val ""))...... 
b8b0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09      (begin......
b8c0: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72         (iup:attr
b8d0: 69 62 75 74 65 2d 73 65 74 21 20 74 62 20 22 56  ibute-set! tb "V
b8e0: 41 4c 55 45 22 20 76 61 6c 29 0a 09 09 09 09 09  ALUE" val)......
b8f0: 20 20 20 20 20 20 20 28 64 62 6f 61 72 64 3a 74         (dboard:t
b900: 61 62 64 61 74 2d 72 75 6e 2d 6e 61 6d 65 2d 73  abdat-run-name-s
b910: 65 74 21 20 74 61 62 64 61 74 20 76 61 6c 29 0a  et! tabdat val).
b920: 09 09 09 09 09 20 20 20 20 20 20 20 28 64 61 73  .....       (das
b930: 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72 75  hboard:update-ru
b940: 6e 2d 63 6f 6d 6d 61 6e 64 20 74 61 62 64 61 74  n-command tabdat
b950: 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20  )))).....       
b960: 22 63 6f 6d 6d 61 6e 64 2d 72 75 6e 6e 61 6d 65  "command-runname
b970: 2d 73 65 6c 65 63 74 6f 72 20 6c 62 20 61 63 74  -selector lb act
b980: 69 6f 6e 22 29 29 29 29 0a 09 20 20 28 72 65 66  ion"))))..  (ref
b990: 72 65 73 68 2d 72 75 6e 73 2d 6c 69 73 74 20 28  resh-runs-list (
b9a0: 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20  lambda ()....   
b9b0: 20 20 20 20 28 69 66 20 28 64 61 73 68 62 6f 61      (if (dashboa
b9c0: 72 64 3a 64 61 74 61 62 61 73 65 2d 63 68 61 6e  rd:database-chan
b9d0: 67 65 64 3f 20 63 6f 6d 6d 6f 6e 64 61 74 20 74  ged? commondat t
b9e0: 61 62 64 61 74 20 63 6f 6e 74 65 78 74 2d 6b 65  abdat context-ke
b9f0: 79 3a 20 27 72 75 6e 6e 61 6d 65 2d 73 65 6c 65  y: 'runname-sele
ba00: 63 74 6f 72 2d 72 75 6e 73 2d 6c 69 73 74 29 0a  ctor-runs-list).
ba10: 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 3b 3b  ....   (let* (;;
ba20: 20 28 74 61 72 67 65 74 20 20 20 20 20 20 20 20   (target        
ba30: 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 74  (dboard:tabdat-t
ba40: 61 72 67 65 74 2d 73 74 72 69 6e 67 20 74 61 62  arget-string tab
ba50: 64 61 74 29 29 0a 09 09 09 09 09 20 20 28 72 75  dat))......  (ru
ba60: 6e 73 2d 66 6f 72 2d 74 61 72 67 20 28 72 6d 74  ns-for-targ (rmt
ba70: 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74  :get-runs-by-pat
ba80: 74 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74  t (dboard:tabdat
ba90: 2d 6b 65 79 73 20 74 61 62 64 61 74 29 20 22 25  -keys tabdat) "%
baa0: 22 20 23 66 20 23 66 20 23 66 20 23 66 20 30 29  " #f #f #f #f 0)
bab0: 29 0a 09 09 09 09 09 20 20 28 72 75 6e 73 2d 68  )......  (runs-h
bac0: 65 61 64 65 72 20 20 20 28 76 65 63 74 6f 72 2d  eader   (vector-
bad0: 72 65 66 20 72 75 6e 73 2d 66 6f 72 2d 74 61 72  ref runs-for-tar
bae0: 67 20 30 29 29 0a 09 09 09 09 09 20 20 28 72 75  g 0))......  (ru
baf0: 6e 73 2d 64 61 74 20 20 20 20 20 20 28 76 65 63  ns-dat      (vec
bb00: 74 6f 72 2d 72 65 66 20 72 75 6e 73 2d 66 6f 72  tor-ref runs-for
bb10: 2d 74 61 72 67 20 31 29 29 0a 09 09 09 09 09 20  -targ 1))...... 
bb20: 20 28 72 75 6e 2d 6e 61 6d 65 73 20 20 20 20 20   (run-names     
bb30: 28 63 6f 6e 73 20 64 65 66 61 75 6c 74 2d 72 75  (cons default-ru
bb40: 6e 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 20  n-name ........ 
bb50: 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62        (map (lamb
bb60: 64 61 20 28 78 29 0a 09 09 09 09 09 09 09 09 20  da (x)......... 
bb70: 20 20 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c       (db:get-val
bb80: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 78 20 72  ue-by-header x r
bb90: 75 6e 73 2d 68 65 61 64 65 72 20 22 72 75 6e 6e  uns-header "runn
bba0: 61 6d 65 22 29 29 0a 09 09 09 09 09 09 09 09 20  ame"))......... 
bbb0: 20 20 20 72 75 6e 73 2d 64 61 74 29 29 29 29 0a     runs-dat)))).
bbc0: 09 09 09 09 20 20 20 20 20 3b 3b 20 28 70 72 69  ....     ;; (pri
bbd0: 6e 74 20 22 44 45 42 55 47 49 4e 46 4f 3a 20 72  nt "DEBUGINFO: r
bbe0: 75 6e 2d 6e 61 6d 65 73 3d 22 20 72 75 6e 2d 6e  un-names=" run-n
bbf0: 61 6d 65 73 29 0a 09 09 09 09 20 20 20 20 20 3b  ames).....     ;
bc00: 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65  ; (iup:attribute
bc10: 2d 73 65 74 21 20 6c 62 20 22 52 45 4d 4f 56 45  -set! lb "REMOVE
bc20: 49 54 45 4d 22 20 22 41 4c 4c 22 29 0a 09 09 09  ITEM" "ALL")....
bc30: 09 20 20 20 20 20 28 69 75 70 6c 69 73 74 62 6f  .     (iuplistbo
bc40: 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 20 72  x-fill-list lb r
bc50: 75 6e 2d 6e 61 6d 65 73 20 73 65 6c 65 63 74 65  un-names selecte
bc60: 64 2d 69 74 65 6d 3a 20 64 65 66 61 75 6c 74 2d  d-item: default-
bc70: 72 75 6e 2d 6e 61 6d 65 29 29 29 29 29 29 0a 20  run-name)))))). 
bc80: 20 20 20 20 3b 3b 20 28 64 62 6f 61 72 64 3a 74      ;; (dboard:t
bc90: 61 62 64 61 74 2d 75 70 64 61 74 65 72 2d 66 6f  abdat-updater-fo
bca0: 72 2d 72 75 6e 73 2d 73 65 74 21 20 74 61 62 64  r-runs-set! tabd
bcb0: 61 74 20 72 65 66 72 65 73 68 2d 72 75 6e 73 2d  at refresh-runs-
bcc0: 6c 69 73 74 29 0a 20 20 20 20 20 28 64 62 6f 61  list).     (dboa
bcd0: 72 64 3a 63 6f 6d 6d 6f 6e 64 61 74 2d 61 64 64  rd:commondat-add
bce0: 2d 75 70 64 61 74 65 72 20 63 6f 6d 6d 6f 6e 64  -updater commond
bcf0: 61 74 20 72 65 66 72 65 73 68 2d 72 75 6e 73 2d  at refresh-runs-
bd00: 6c 69 73 74 20 74 61 62 2d 6e 75 6d 3a 20 74 61  list tab-num: ta
bd10: 62 2d 6e 75 6d 29 0a 20 20 20 20 20 3b 3b 20 28  b-num).     ;; (
bd20: 72 65 66 72 65 73 68 2d 72 75 6e 73 2d 6c 69 73  refresh-runs-lis
bd30: 74 29 0a 20 20 20 20 20 28 64 62 6f 61 72 64 3a  t).     (dboard:
bd40: 74 61 62 64 61 74 2d 72 75 6e 2d 6e 61 6d 65 2d  tabdat-run-name-
bd50: 73 65 74 21 20 74 61 62 64 61 74 20 64 65 66 61  set! tabdat defa
bd60: 75 6c 74 2d 72 75 6e 2d 6e 61 6d 65 29 0a 20 20  ult-run-name).  
bd70: 20 20 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20     (iup:hbox.   
bd80: 20 20 20 74 62 0a 20 20 20 20 20 20 6c 62 29 29     tb.      lb))
bd90: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 6f  ))..(define (dco
bda0: 6d 6d 6f 6e 3a 63 6f 6d 6d 61 6e 64 2d 74 65 73  mmon:command-tes
bdb0: 74 6e 61 6d 65 2d 73 65 6c 65 63 74 6f 72 20 63  tname-selector c
bdc0: 6f 6d 6d 6f 6e 64 61 74 20 74 61 62 64 61 74 20  ommondat tabdat 
bdd0: 75 70 64 61 74 65 2d 6b 65 79 76 61 6c 73 29 20  update-keyvals) 
bde0: 3b 3b 20 20 6b 65 79 2d 6c 69 73 74 62 6f 78 65  ;;  key-listboxe
bdf0: 73 29 0a 20 20 28 69 75 70 3a 76 62 6f 78 0a 20  s).  (iup:vbox. 
be00: 20 20 3b 3b 20 54 65 78 74 20 62 6f 78 20 66 6f    ;; Text box fo
be10: 72 20 74 65 73 74 20 70 61 74 74 65 72 6e 73 0a  r test patterns.
be20: 20 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20     (iup:frame.  
be30: 20 20 23 3a 74 69 74 6c 65 20 22 54 65 73 74 20    #:title "Test 
be40: 70 61 74 74 65 72 6e 73 20 28 6f 6e 65 20 70 65  patterns (one pe
be50: 72 20 6c 69 6e 65 29 22 0a 20 20 20 20 28 6c 65  r line)".    (le
be60: 74 20 28 28 74 62 20 28 69 75 70 3a 74 65 78 74  t ((tb (iup:text
be70: 62 6f 78 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61  box #:action (la
be80: 6d 62 64 61 20 28 76 61 6c 20 61 20 62 29 0a 09  mbda (val a b)..
be90: 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a  ...      (debug:
bea0: 63 61 74 63 68 2d 61 6e 64 2d 64 75 6d 70 0a 09  catch-and-dump..
beb0: 09 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64  ...       (lambd
bec0: 61 20 28 29 0a 09 09 09 09 09 20 28 64 62 6f 61  a ()...... (dboa
bed0: 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d 70  rd:tabdat-test-p
bee0: 61 74 74 73 2d 73 65 74 21 2d 75 73 65 0a 09 09  atts-set!-use...
bef0: 09 09 09 20 20 74 61 62 64 61 74 0a 09 09 09 09  ...  tabdat.....
bf00: 09 20 20 28 64 62 6f 61 72 64 3a 6c 69 6e 65 73  .  (dboard:lines
bf10: 2d 3e 74 65 73 74 2d 70 61 74 74 20 62 29 29 0a  ->test-patt b)).
bf20: 09 09 09 09 09 20 28 64 61 73 68 62 6f 61 72 64  ..... (dashboard
bf30: 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d  :update-run-comm
bf40: 61 6e 64 20 74 61 62 64 61 74 29 29 0a 09 09 09  and tabdat))....
bf50: 09 20 20 20 20 20 20 20 22 63 6f 6d 6d 61 6e 64  .       "command
bf60: 2d 74 65 73 74 6e 61 6d 65 2d 73 65 6c 65 63 74  -testname-select
bf70: 6f 72 20 74 62 20 61 63 74 69 6f 6e 22 29 29 0a  or tb action")).
bf80: 09 09 09 20 20 20 23 3a 76 61 6c 75 65 20 28 64  ...   #:value (d
bf90: 62 6f 61 72 64 3a 74 65 73 74 2d 70 61 74 74 2d  board:test-patt-
bfa0: 3e 6c 69 6e 65 73 0a 09 09 09 09 20 20 20 20 28  >lines.....    (
bfb0: 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 74 65  dboard:tabdat-te
bfc0: 73 74 2d 70 61 74 74 73 2d 75 73 65 20 74 61 62  st-patts-use tab
bfd0: 64 61 74 29 29 0a 09 09 09 20 20 20 23 3a 65 78  dat))....   #:ex
bfe0: 70 61 6e 64 20 22 59 45 53 22 0a 09 09 09 20 20  pand "YES"....  
bff0: 20 23 3a 73 69 7a 65 20 22 78 33 30 22 20 3b 3b   #:size "x30" ;;
c000: 20 77 61 73 20 31 30 78 33 30 0a 09 09 09 20 20   was 10x30....  
c010: 20 23 3a 6d 75 6c 74 69 6c 69 6e 65 20 22 59 45   #:multiline "YE
c020: 53 22 29 29 29 0a 20 20 20 20 20 20 28 73 65 74  S"))).      (set
c030: 21 20 74 65 73 74 2d 70 61 74 74 65 72 6e 73 2d  ! test-patterns-
c040: 74 65 78 74 62 6f 78 20 74 62 29 0a 20 20 20 20  textbox tb).    
c050: 20 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74    (dboard:tabdat
c060: 2d 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 2d 73 65 74 21 20 74 61 62 64  extbox-set! tabd
c080: 61 74 20 74 62 29 0a 20 20 20 20 20 20 74 62 29  at tb).      tb)
c090: 29 0a 3b 3b 20 28 69 75 70 3a 66 72 61 6d 65 0a  ).;; (iup:frame.
c0a0: 3b 3b 20 20 23 3a 74 69 74 6c 65 20 22 54 61 72  ;;  #:title "Tar
c0b0: 67 65 74 22 0a 3b 3b 20 20 3b 3b 20 54 61 72 67  get".;;  ;; Targ
c0c0: 65 74 20 73 65 6c 65 63 74 6f 72 73 0a 3b 3b 20  et selectors.;; 
c0d0: 20 28 61 70 70 6c 79 20 69 75 70 3a 68 62 6f 78   (apply iup:hbox
c0e0: 0a 3b 3b 20 09 20 20 20 28 6c 65 74 2a 20 28 28  .;; .   (let* ((
c0f0: 64 61 74 20 20 20 20 20 20 28 64 61 73 68 62 6f  dat      (dashbo
c100: 61 72 64 3a 75 70 64 61 74 65 2d 74 61 72 67 65  ard:update-targe
c110: 74 2d 73 65 6c 65 63 74 6f 72 20 74 61 62 64 61  t-selector tabda
c120: 74 20 61 63 74 69 6f 6e 2d 70 72 6f 63 3a 20 75  t action-proc: u
c130: 70 64 61 74 65 2d 6b 65 79 76 61 6c 73 29 29 0a  pdate-keyvals)).
c140: 3b 3b 20 09 09 20 20 28 6b 65 79 2d 6c 62 20 20  ;; ..  (key-lb  
c150: 20 28 63 61 72 20 64 61 74 29 29 0a 3b 3b 20 09   (car dat)).;; .
c160: 09 20 20 28 63 6f 6d 62 6f 73 20 20 20 28 63 61  .  (combos   (ca
c170: 64 72 20 64 61 74 29 29 29 0a 3b 3b 20 09 20 20  dr dat))).;; .  
c180: 20 20 20 63 6f 6d 62 6f 73 29 29 29 0a 20 20 20     combos))).   
c190: 3b 3b 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20  ;; (iup:hbox.   
c1a0: 3b 3b 20 20 3b 3b 20 54 65 78 74 20 62 6f 78 20  ;;  ;; Text box 
c1b0: 66 6f 72 20 53 54 41 54 45 53 0a 20 20 20 3b 3b  for STATES.   ;;
c1c0: 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 20    (iup:frame.   
c1d0: 3b 3b 20 20 20 23 3a 74 69 74 6c 65 20 22 53 74  ;;   #:title "St
c1e0: 61 74 65 73 22 0a 20 20 20 3b 3b 20 20 20 28 64  ates".   ;;   (d
c1f0: 61 73 68 62 6f 61 72 64 3a 74 65 78 74 2d 6c 69  ashboard:text-li
c200: 73 74 2d 74 6f 67 67 6c 65 2d 62 6f 78 20 0a 20  st-toggle-box . 
c210: 20 20 3b 3b 20 20 20 20 3b 3b 20 4d 6f 76 65 20    ;;    ;; Move 
c220: 74 68 65 73 65 20 64 65 66 69 6e 69 74 69 6f 6e  these definition
c230: 73 20 74 6f 20 63 6f 6d 6d 6f 6e 20 61 6e 64 20  s to common and 
c240: 66 69 6e 64 20 74 68 65 20 6f 74 68 65 72 20 75  find the other u
c250: 73 65 61 67 65 73 20 61 6e 64 20 72 65 70 6c 61  seages and repla
c260: 63 65 21 0a 20 20 20 3b 3b 20 20 20 20 28 6d 61  ce!.   ;;    (ma
c270: 70 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73  p cadr *common:s
c280: 74 64 2d 73 74 61 74 65 73 2a 29 20 3b 3b 20 27  td-states*) ;; '
c290: 28 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 52 55  ("COMPLETED" "RU
c2a0: 4e 4e 49 4e 47 22 20 22 53 54 55 43 4b 22 20 22  NNING" "STUCK" "
c2b0: 49 4e 43 4f 4d 50 4c 45 54 45 22 20 22 4c 41 55  INCOMPLETE" "LAU
c2c0: 4e 43 48 45 44 22 20 22 52 45 4d 4f 54 45 48 4f  NCHED" "REMOTEHO
c2d0: 53 54 53 54 41 52 54 22 20 22 4b 49 4c 4c 45 44  STSTART" "KILLED
c2e0: 22 29 0a 20 20 20 3b 3b 20 20 20 20 28 6c 61 6d  ").   ;;    (lam
c2f0: 62 64 61 20 28 61 6c 6c 29 0a 20 20 20 3b 3b 20  bda (all).   ;; 
c300: 20 20 20 20 20 28 64 62 6f 61 72 64 3a 74 61 62       (dboard:tab
c310: 64 61 74 2d 73 74 61 74 65 73 2d 73 65 74 21 20  dat-states-set! 
c320: 74 61 62 64 61 74 20 61 6c 6c 29 0a 20 20 20 3b  tabdat all).   ;
c330: 3b 20 20 20 20 20 20 28 64 61 73 68 62 6f 61 72  ;      (dashboar
c340: 64 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d  d:update-run-com
c350: 6d 61 6e 64 20 74 61 62 64 61 74 29 29 29 29 0a  mand tabdat)))).
c360: 20 20 20 3b 3b 20 20 3b 3b 20 54 65 78 74 20 62     ;;  ;; Text b
c370: 6f 78 20 66 6f 72 20 53 54 41 54 45 53 0a 20 20  ox for STATES.  
c380: 20 3b 3b 20 20 28 69 75 70 3a 66 72 61 6d 65 0a   ;;  (iup:frame.
c390: 20 20 20 3b 3b 20 20 20 23 3a 74 69 74 6c 65 20     ;;   #:title 
c3a0: 22 53 74 61 74 75 73 65 73 22 0a 20 20 20 3b 3b  "Statuses".   ;;
c3b0: 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 74 65     (dashboard:te
c3c0: 78 74 2d 6c 69 73 74 2d 74 6f 67 67 6c 65 2d 62  xt-list-toggle-b
c3d0: 6f 78 20 0a 20 20 20 3b 3b 20 20 20 20 28 6d 61  ox .   ;;    (ma
c3e0: 70 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73  p cadr *common:s
c3f0: 74 64 2d 73 74 61 74 75 73 65 73 2a 29 20 3b 3b  td-statuses*) ;;
c400: 20 27 28 22 50 41 53 53 22 20 22 46 41 49 4c 22   '("PASS" "FAIL"
c410: 20 22 6e 2f 61 22 20 22 43 48 45 43 4b 22 20 22   "n/a" "CHECK" "
c420: 57 41 49 56 45 44 22 20 22 53 4b 49 50 22 20 22  WAIVED" "SKIP" "
c430: 44 45 4c 45 54 45 44 22 20 22 53 54 55 43 4b 2f  DELETED" "STUCK/
c440: 44 45 41 44 22 29 0a 20 20 20 3b 3b 20 20 20 20  DEAD").   ;;    
c450: 28 6c 61 6d 62 64 61 20 28 61 6c 6c 29 0a 20 20  (lambda (all).  
c460: 20 3b 3b 20 20 20 20 20 20 28 64 62 6f 61 72 64   ;;      (dboard
c470: 3a 74 61 62 64 61 74 2d 73 74 61 74 75 73 65 73  :tabdat-statuses
c480: 2d 73 65 74 21 20 74 61 62 64 61 74 20 61 6c 6c  -set! tabdat all
c490: 29 0a 20 20 20 3b 3b 20 20 20 20 20 20 28 64 61  ).   ;;      (da
c4a0: 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72  shboard:update-r
c4b0: 75 6e 2d 63 6f 6d 6d 61 6e 64 20 74 61 62 64 61  un-command tabda
c4c0: 74 29 29 29 29 29 0a 20 20 20 29 29 0a 0a 28 64  t))))).   ))..(d
c4d0: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 63  efine (dcommon:c
c4e0: 6f 6d 6d 61 6e 64 2d 74 65 73 74 73 2d 74 61 73  ommand-tests-tas
c4f0: 6b 73 2d 63 61 6e 76 61 73 20 74 61 62 64 61 74  ks-canvas tabdat
c500: 20 74 65 73 74 2d 72 65 63 6f 72 64 73 20 73 6f   test-records so
c510: 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 20 74  rted-testnames t
c520: 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 29  ests-draw-state)
c530: 0a 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20  .  (iup:frame.  
c540: 20 23 3a 74 69 74 6c 65 20 22 54 65 73 74 73 20   #:title "Tests 
c550: 61 6e 64 20 54 61 73 6b 73 22 0a 20 20 20 28 6c  and Tasks".   (l
c560: 65 74 2a 20 28 28 75 70 64 61 74 65 72 20 23 66  et* ((updater #f
c570: 29 0a 09 20 20 28 6c 61 73 74 2d 78 61 64 6a 20  )..  (last-xadj 
c580: 30 29 0a 09 20 20 28 6c 61 73 74 2d 79 61 64 6a  0)..  (last-yadj
c590: 20 30 29 0a 09 20 20 28 74 68 65 2d 63 6e 76 20   0)..  (the-cnv 
c5a0: 20 20 23 66 29 0a 09 20 20 28 63 61 6e 76 61 73    #f)..  (canvas
c5b0: 2d 6f 62 6a 20 0a 09 20 20 20 28 69 75 70 3a 63  -obj ..   (iup:c
c5c0: 61 6e 76 61 73 20 23 3a 61 63 74 69 6f 6e 20 28  anvas #:action (
c5d0: 6d 61 6b 65 2d 63 61 6e 76 61 73 2d 61 63 74 69  make-canvas-acti
c5e0: 6f 6e 0a 09 09 09 09 20 28 6c 61 6d 62 64 61 20  on..... (lambda 
c5f0: 28 63 6e 76 20 78 61 64 6a 20 79 61 64 6a 29 0a  (cnv xadj yadj).
c600: 09 09 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20  ....   (if (not 
c610: 75 70 64 61 74 65 72 29 0a 09 09 09 09 20 20 20  updater).....   
c620: 20 20 20 20 28 73 65 74 21 20 75 70 64 61 74 65      (set! update
c630: 72 20 28 6c 61 6d 62 64 61 20 28 78 61 64 6a 20  r (lambda (xadj 
c640: 79 61 64 6a 29 0a 09 09 09 09 09 09 20 20 20 20  yadj).......    
c650: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 63 6e     ;; (print "cn
c660: 76 3a 20 22 20 63 6e 76 20 22 20 78 61 64 6a 3a  v: " cnv " xadj:
c670: 20 22 20 78 61 64 6a 20 22 20 79 61 64 6a 3a 20   " xadj " yadj: 
c680: 22 20 79 61 64 6a 29 0a 09 09 09 09 09 09 20 20  " yadj).......  
c690: 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a       (dashboard:
c6a0: 64 72 61 77 2d 74 65 73 74 73 20 63 6e 76 20 78  draw-tests cnv x
c6b0: 61 64 6a 20 79 61 64 6a 20 74 65 73 74 73 2d 64  adj yadj tests-d
c6c0: 72 61 77 2d 73 74 61 74 65 20 73 6f 72 74 65 64  raw-state sorted
c6d0: 2d 74 65 73 74 6e 61 6d 65 73 20 74 65 73 74 2d  -testnames test-
c6e0: 72 65 63 6f 72 64 73 29 0a 09 09 09 09 09 09 20  records)....... 
c6f0: 20 20 20 20 20 20 28 73 65 74 21 20 6c 61 73 74        (set! last
c700: 2d 78 61 64 6a 20 78 61 64 6a 29 0a 09 09 09 09  -xadj xadj).....
c710: 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 6c  ..       (set! l
c720: 61 73 74 2d 79 61 64 6a 20 79 61 64 6a 29 29 29  ast-yadj yadj)))
c730: 29 0a 09 09 09 09 20 20 20 28 75 70 64 61 74 65  ).....   (update
c740: 72 20 78 61 64 6a 20 79 61 64 6a 29 0a 09 09 09  r xadj yadj)....
c750: 09 20 20 20 28 73 65 74 21 20 74 68 65 2d 63 6e  .   (set! the-cn
c760: 76 20 63 6e 76 29 0a 09 09 09 09 20 20 20 29 29  v cnv).....   ))
c770: 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 46 6f 6c  ...       ;; Fol
c780: 6c 6f 77 69 6e 67 20 64 6f 65 73 6e 27 74 20 77  lowing doesn't w
c790: 6f 72 6b 20 0a 09 09 20 20 20 20 20 20 20 23 3a  ork ...       #:
c7a0: 77 68 65 65 6c 2d 63 62 20 28 6c 61 6d 62 64 61  wheel-cb (lambda
c7b0: 20 28 6f 62 6a 20 73 74 65 70 20 78 20 79 20 64   (obj step x y d
c7c0: 69 72 29 20 3b 3b 20 64 69 72 20 69 73 20 34 20  ir) ;; dir is 4 
c7d0: 66 6f 72 20 75 70 20 61 6e 64 20 35 20 66 6f 72  for up and 5 for
c7e0: 20 64 6f 77 6e 2e 20 49 20 74 68 69 6e 6b 2e 0a   down. I think..
c7f0: 09 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 73  ....    (let ((s
c800: 63 61 6c 65 66 20 28 68 61 73 68 2d 74 61 62 6c  calef (hash-tabl
c810: 65 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 77  e-ref tests-draw
c820: 2d 73 74 61 74 65 20 27 73 63 61 6c 65 66 29 29  -state 'scalef))
c830: 29 0a 09 09 09 09 20 20 20 20 20 20 28 68 61 73  ).....      (has
c840: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73  h-table-set! tes
c850: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73  ts-draw-state 's
c860: 63 61 6c 65 66 20 28 2b 20 73 63 61 6c 65 66 0a  calef (+ scalef.
c870: 09 09 09 09 09 09 09 09 09 09 20 20 20 28 69 66  ..........   (if
c880: 20 28 3e 20 73 74 65 70 20 30 29 0a 09 09 09 09   (> step 0).....
c890: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 2a 20  ......       (* 
c8a0: 73 63 61 6c 65 66 20 30 2e 30 31 29 0a 09 09 09  scalef 0.01)....
c8b0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 2a  .......       (*
c8c0: 20 73 63 61 6c 65 66 20 2d 30 2e 30 31 29 29 29   scalef -0.01)))
c8d0: 29 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 20  ).....      (if 
c8e0: 74 68 65 2d 63 6e 76 0a 09 09 09 09 09 20 20 28  the-cnv......  (
c8f0: 64 61 73 68 62 6f 61 72 64 3a 64 72 61 77 2d 74  dashboard:draw-t
c900: 65 73 74 73 20 74 68 65 2d 63 6e 76 20 6c 61 73  ests the-cnv las
c910: 74 2d 78 61 64 6a 20 6c 61 73 74 2d 79 61 64 6a  t-xadj last-yadj
c920: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74   tests-draw-stat
c930: 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d  e sorted-testnam
c940: 65 73 20 74 65 73 74 2d 72 65 63 6f 72 64 73 29  es test-records)
c950: 29 0a 09 09 09 09 20 20 20 20 20 20 29 29 0a 09  ).....      ))..
c960: 09 20 20 20 20 20 20 20 3b 3b 20 23 3a 73 69 7a  .       ;; #:siz
c970: 65 20 22 32 35 30 78 32 35 30 22 0a 09 09 20 20  e "250x250"...  
c980: 20 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59       #:expand "Y
c990: 45 53 22 0a 09 09 20 20 20 20 20 20 20 23 3a 73  ES"...       #:s
c9a0: 63 72 6f 6c 6c 62 61 72 20 22 59 45 53 22 0a 09  crollbar "YES"..
c9b0: 09 20 20 20 20 20 20 20 23 3a 70 6f 73 78 20 22  .       #:posx "
c9c0: 30 2e 35 22 0a 09 09 20 20 20 20 20 20 20 23 3a  0.5"...       #:
c9d0: 70 6f 73 79 20 22 30 2e 35 22 0a 09 09 20 20 20  posy "0.5"...   
c9e0: 20 20 20 20 23 3a 62 75 74 74 6f 6e 2d 63 62 20      #:button-cb 
c9f0: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 62 74 6e  (lambda (obj btn
ca00: 20 70 72 65 73 73 65 64 20 78 20 79 20 73 74 61   pressed x y sta
ca10: 74 75 73 29 0a 09 09 09 09 20 20 20 20 20 3b 3b  tus).....     ;;
ca20: 20 28 70 72 69 6e 74 20 22 6f 62 6a 3a 20 22 20   (print "obj: " 
ca30: 6f 62 6a 20 22 2c 20 70 72 65 73 73 65 64 20 22  obj ", pressed "
ca40: 20 70 72 65 73 73 65 64 20 22 2c 20 73 74 61 74   pressed ", stat
ca50: 75 73 20 22 20 73 74 61 74 75 73 29 0a 09 09 09  us " status)....
ca60: 09 09 3b 20 28 70 72 69 6e 74 20 22 63 61 6e 76  ..; (print "canv
ca70: 61 73 2d 6f 72 69 67 69 6e 3a 20 22 20 28 63 61  as-origin: " (ca
ca80: 6e 76 61 73 2d 6f 72 69 67 69 6e 20 74 68 65 2d  nvas-origin the-
ca90: 63 6e 76 29 29 0a 09 09 09 09 20 20 20 20 20 3b  cnv)).....     ;
caa0: 3b 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28  ; (let-values ((
cab0: 28 78 78 20 79 79 29 28 63 61 6e 76 61 73 2d 6f  (xx yy)(canvas-o
cac0: 72 69 67 69 6e 20 74 68 65 2d 63 6e 76 29 29 29  rigin the-cnv)))
cad0: 0a 09 09 09 09 20 20 20 20 20 3b 3b 20 28 63 61  .....     ;; (ca
cae0: 6e 76 61 73 2d 74 72 61 6e 73 66 6f 72 6d 2d 73  nvas-transform-s
caf0: 65 74 21 20 74 68 65 2d 63 6e 76 20 23 66 29 0a  et! the-cnv #f).
cb00: 09 09 09 09 20 20 20 20 20 3b 3b 20 28 70 72 69  ....     ;; (pri
cb10: 6e 74 20 22 63 61 6e 76 61 73 2d 6f 72 69 67 69  nt "canvas-origi
cb20: 6e 3a 20 22 20 78 78 20 22 20 22 20 79 79 20 22  n: " xx " " yy "
cb30: 20 63 6c 69 63 6b 20 61 74 20 22 20 78 20 22 20   click at " x " 
cb40: 22 20 79 29 29 0a 09 09 09 09 20 20 20 20 20 28  " y)).....     (
cb50: 6c 65 74 2a 20 28 28 74 65 73 74 73 2d 69 6e 66  let* ((tests-inf
cb60: 6f 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c  o     (hash-tabl
cb70: 65 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 77  e-ref tests-draw
cb80: 2d 73 74 61 74 65 20 27 74 65 73 74 73 2d 69 6e  -state 'tests-in
cb90: 66 6f 29 29 0a 09 09 09 09 09 20 20 20 20 28 73  fo))......    (s
cba0: 65 6c 65 63 74 65 64 2d 74 65 73 74 73 20 28 68  elected-tests (h
cbb0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65  ash-table-ref te
cbc0: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27  sts-draw-state '
cbd0: 73 65 6c 65 63 74 65 64 2d 74 65 73 74 73 29 29  selected-tests))
cbe0: 0a 09 09 09 09 09 20 20 20 20 28 73 63 61 6c 65  ......    (scale
cbf0: 66 20 20 20 20 20 20 20 20 20 28 68 61 73 68 2d  f         (hash-
cc00: 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 73 2d  table-ref tests-
cc10: 64 72 61 77 2d 73 74 61 74 65 20 27 73 63 61 6c  draw-state 'scal
cc20: 65 66 29 29 0a 09 09 09 09 09 20 20 20 20 28 73  ef))......    (s
cc30: 69 7a 65 79 20 20 20 20 20 20 20 20 20 20 28 68  izey          (h
cc40: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65  ash-table-ref te
cc50: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27  sts-draw-state '
cc60: 73 69 7a 65 79 29 29 0a 09 09 09 09 09 20 20 20  sizey))......   
cc70: 20 28 78 6f 66 66 73 65 74 20 20 20 20 20 20 20   (xoffset       
cc80: 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 78 6f   (dcommon:get-xo
cc90: 66 66 73 65 74 20 74 65 73 74 73 2d 64 72 61 77  ffset tests-draw
cca0: 2d 73 74 61 74 65 20 23 66 20 23 66 29 29 0a 09  -state #f #f))..
ccb0: 09 09 09 09 20 20 20 20 28 79 6f 66 66 73 65 74  ....    (yoffset
ccc0: 20 20 20 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e          (dcommon
ccd0: 3a 67 65 74 2d 79 6f 66 66 73 65 74 20 74 65 73  :get-yoffset tes
cce0: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 23 66  ts-draw-state #f
ccf0: 20 23 66 29 29 0a 09 09 09 09 09 20 20 20 20 28   #f))......    (
cd00: 6e 65 77 2d 79 20 20 20 20 20 20 20 20 20 20 28  new-y          (
cd10: 2d 20 73 69 7a 65 79 20 79 29 29 0a 09 09 09 09  - sizey y)).....
cd20: 09 20 20 20 20 28 74 65 73 74 2d 70 61 74 74 65  .    (test-patte
cd30: 72 6e 73 2d 74 65 78 74 62 6f 78 20 28 64 62 6f  rns-textbox (dbo
cd40: 61 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d  ard:tabdat-test-
cd50: 70 61 74 74 65 72 6e 73 2d 74 65 78 74 62 6f 78  patterns-textbox
cd60: 20 74 61 62 64 61 74 29 29 29 0a 09 09 09 09 20   tabdat)))..... 
cd70: 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20        ;; (print 
cd80: 22 78 6f 66 66 73 65 74 3d 22 20 78 6f 66 66 73  "xoffset=" xoffs
cd90: 65 74 20 22 2c 20 79 6f 66 66 73 65 74 3d 22 20  et ", yoffset=" 
cda0: 79 6f 66 66 73 65 74 29 0a 09 09 09 09 20 20 20  yoffset).....   
cdb0: 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 5c      ;; (print "\
cdc0: 74 78 5c 74 79 5c 74 6c 6c 78 5c 74 6c 6c 79 5c  tx\ty\tllx\tlly\
cdd0: 74 75 72 78 5c 74 75 72 79 22 29 0a 09 09 09 09  turx\tury").....
cde0: 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68         (for-each
cdf0: 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 6e   (lambda (test-n
ce00: 61 6d 65 29 0a 09 09 09 09 09 09 20 20 20 28 6c  ame).......   (l
ce10: 65 74 2a 20 28 28 72 65 63 2d 63 6f 6f 72 64 73  et* ((rec-coords
ce20: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66   (hash-table-ref
ce30: 20 74 65 73 74 73 2d 69 6e 66 6f 20 74 65 73 74   tests-info test
ce40: 2d 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 09 20  -name))........ 
ce50: 20 28 6c 6c 78 20 20 20 20 20 20 20 20 28 64 63   (llx        (dc
ce60: 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 73 20  ommon:x->canvas 
ce70: 28 6c 69 73 74 2d 72 65 66 20 72 65 63 2d 63 6f  (list-ref rec-co
ce80: 6f 72 64 73 20 30 29 20 73 63 61 6c 65 66 20 78  ords 0) scalef x
ce90: 6f 66 66 73 65 74 29 29 0a 09 09 09 09 09 09 09  offset))........
cea0: 20 20 28 6c 6c 79 20 20 20 20 20 20 20 20 28 64    (lly        (d
ceb0: 63 6f 6d 6d 6f 6e 3a 79 2d 3e 63 61 6e 76 61 73  common:y->canvas
cec0: 20 28 6c 69 73 74 2d 72 65 66 20 72 65 63 2d 63   (list-ref rec-c
ced0: 6f 6f 72 64 73 20 31 29 20 73 63 61 6c 65 66 20  oords 1) scalef 
cee0: 79 6f 66 66 73 65 74 29 29 0a 09 09 09 09 09 09  yoffset)).......
cef0: 09 20 20 28 75 72 78 20 20 20 20 20 20 20 20 28  .  (urx        (
cf00: 64 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61  dcommon:x->canva
cf10: 73 20 28 6c 69 73 74 2d 72 65 66 20 72 65 63 2d  s (list-ref rec-
cf20: 63 6f 6f 72 64 73 20 32 29 20 73 63 61 6c 65 66  coords 2) scalef
cf30: 20 78 6f 66 66 73 65 74 29 29 0a 09 09 09 09 09   xoffset))......
cf40: 09 09 20 20 28 75 72 79 20 20 20 20 20 20 20 20  ..  (ury        
cf50: 28 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e 63 61 6e 76  (dcommon:y->canv
cf60: 61 73 20 28 6c 69 73 74 2d 72 65 66 20 72 65 63  as (list-ref rec
cf70: 2d 63 6f 6f 72 64 73 20 33 29 20 73 63 61 6c 65  -coords 3) scale
cf80: 66 20 79 6f 66 66 73 65 74 29 29 29 0a 09 09 09  f yoffset)))....
cf90: 09 09 09 20 20 20 20 20 3b 3b 20 28 69 66 20 28  ...     ;; (if (
cfa0: 65 71 3f 20 70 72 65 73 73 65 64 20 31 29 0a 09  eq? pressed 1)..
cfb0: 09 09 09 09 09 20 20 20 20 20 3b 3b 20 20 20 20  .....     ;;    
cfc0: 28 70 72 69 6e 74 20 22 5c 74 78 3d 22 20 78 20  (print "\tx=" x 
cfd0: 22 5c 74 79 3d 22 20 79 20 22 5c 74 6e 65 77 2d  "\ty=" y "\tnew-
cfe0: 79 3d 22 20 6e 65 77 2d 79 20 22 5c 74 6c 6c 78  y=" new-y "\tllx
cff0: 3d 22 20 6c 6c 78 20 22 5c 74 6c 6c 79 3d 22 20  =" llx "\tlly=" 
d000: 6c 6c 79 20 22 5c 74 75 72 78 3d 22 20 75 72 78  lly "\turx=" urx
d010: 20 22 5c 74 75 72 79 3d 22 20 75 72 79 20 22 5c   "\tury=" ury "\
d020: 74 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 22  t" test-name " "
d030: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 69  )).......     (i
d040: 66 20 28 61 6e 64 20 28 65 71 3f 20 70 72 65 73  f (and (eq? pres
d050: 73 65 64 20 31 29 0a 09 09 09 09 09 09 09 20 20  sed 1)........  
d060: 20 20 20 20 28 3e 3d 20 78 20 6c 6c 78 29 0a 09      (>= x llx)..
d070: 09 09 09 09 09 09 20 20 20 20 20 20 28 3e 3d 20  ......      (>= 
d080: 6e 65 77 2d 79 20 6c 6c 79 29 0a 09 09 09 09 09  new-y lly)......
d090: 09 09 20 20 20 20 20 20 28 3c 3d 20 78 20 75 72  ..      (<= x ur
d0a0: 78 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20  x)........      
d0b0: 28 3c 3d 20 6e 65 77 2d 79 20 75 72 79 29 29 0a  (<= new-y ury)).
d0c0: 09 09 09 09 09 09 09 20 28 6c 65 74 2a 20 28 28  ....... (let* ((
d0d0: 62 6f 78 2d 70 61 74 74 65 72 6e 73 20 28 73 74  box-patterns (st
d0e0: 72 69 6e 67 2d 73 70 6c 69 74 20 28 69 75 70 3a  ring-split (iup:
d0f0: 61 74 74 72 69 62 75 74 65 20 74 65 73 74 2d 70  attribute test-p
d100: 61 74 74 65 72 6e 73 2d 74 65 78 74 62 6f 78 20  atterns-textbox 
d110: 22 56 41 4c 55 45 22 29 29 29 0a 20 20 20 20 20  "VALUE"))).     
d120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
d130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
d140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
d150: 20 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74             (test
d160: 2d 70 61 74 74 73 20 20 20 28 73 74 72 69 6e 67  -patts   (string
d170: 2d 73 70 6c 69 74 20 28 6f 72 20 28 64 62 6f 61  -split (or (dboa
d180: 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d 70  rd:tabdat-test-p
d190: 61 74 74 73 20 74 61 62 64 61 74 29 0a 20 20 20  atts tabdat).   
d1a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
d1b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
d1c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
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 22 22 29               "")
d200: 0a 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 20 20 20 20                  
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 22 2c 22               ","
d260: 29 29 0a 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 20 20 20 20                  
d290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
d2a0: 20 20 20 28 70 61 74 74 65 72 6e 73 20 20 20 20     (patterns    
d2b0: 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61   (delete-duplica
d2c0: 74 65 73 20 28 61 70 70 65 6e 64 20 62 6f 78 2d  tes (append box-
d2d0: 70 61 74 74 65 72 6e 73 20 74 65 73 74 2d 70 61  patterns test-pa
d2e0: 74 74 73 29 29 29 29 20 0a 09 09 09 09 09 09 09  tts)))) ........
d2f0: 20 20 20 28 6c 65 74 2a 20 28 28 73 65 6c 65 63     (let* ((selec
d300: 74 65 64 20 20 20 20 20 28 6e 6f 74 20 28 6d 65  ted     (not (me
d310: 6d 62 65 72 20 74 65 73 74 2d 6e 61 6d 65 20 70  mber test-name p
d320: 61 74 74 65 72 6e 73 29 29 29 0a 09 09 09 09 09  atterns)))......
d330: 09 09 09 20 20 28 6e 65 77 70 61 74 74 2d 6c 69  ...  (newpatt-li
d340: 73 74 20 28 69 66 20 73 65 6c 65 63 74 65 64 0a  st (if selected.
d350: 09 09 09 09 09 09 09 09 09 09 20 20 20 20 28 63  ..........    (c
d360: 6f 6e 73 20 74 65 73 74 2d 6e 61 6d 65 20 70 61  ons test-name pa
d370: 74 74 65 72 6e 73 29 0a 09 09 09 09 09 09 09 09  tterns).........
d380: 09 09 20 20 20 20 28 64 65 6c 65 74 65 20 74 65  ..    (delete te
d390: 73 74 2d 6e 61 6d 65 20 70 61 74 74 65 72 6e 73  st-name patterns
d3a0: 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 28 6e  ))).........  (n
d3b0: 65 77 70 61 74 74 20 20 20 20 20 20 28 73 74 72  ewpatt      (str
d3c0: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20  ing-intersperse 
d3d0: 6e 65 77 70 61 74 74 2d 6c 69 73 74 20 22 5c 6e  newpatt-list "\n
d3e0: 22 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20  ")))........    
d3f0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d   (iup:attribute-
d400: 73 65 74 21 20 74 65 73 74 2d 70 61 74 74 65 72  set! test-patter
d410: 6e 73 2d 74 65 78 74 62 6f 78 20 22 56 41 4c 55  ns-textbox "VALU
d420: 45 22 20 6e 65 77 70 61 74 74 29 0a 09 09 09 09  E" newpatt).....
d430: 09 09 09 20 20 20 20 20 28 69 75 70 3a 61 74 74  ...     (iup:att
d440: 72 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20  ribute-set! obj 
d450: 22 52 45 44 52 41 57 22 20 22 41 4c 4c 22 29 0a  "REDRAW" "ALL").
d460: 09 09 09 09 09 09 09 20 20 20 20 20 28 68 61 73  .......     (has
d470: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 6c  h-table-set! sel
d480: 65 63 74 65 64 2d 74 65 73 74 73 20 74 65 73 74  ected-tests test
d490: 2d 6e 61 6d 65 20 73 65 6c 65 63 74 65 64 29 0a  -name selected).
d4a0: 09 09 09 09 09 09 09 20 20 20 20 20 28 64 62 6f  .......     (dbo
d4b0: 61 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d  ard:tabdat-test-
d4c0: 70 61 74 74 73 2d 73 65 74 21 2d 75 73 65 20 74  patts-set!-use t
d4d0: 61 62 64 61 74 20 28 64 62 6f 61 72 64 3a 6c 69  abdat (dboard:li
d4e0: 6e 65 73 2d 3e 74 65 73 74 2d 70 61 74 74 20 6e  nes->test-patt n
d4f0: 65 77 70 61 74 74 29 29 0a 09 09 09 09 09 09 09  ewpatt))........
d500: 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a       (dashboard:
d510: 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61  update-run-comma
d520: 6e 64 20 74 61 62 64 61 74 29 0a 09 09 09 09 09  nd tabdat)......
d530: 09 09 20 20 20 20 20 28 69 66 20 75 70 64 61 74  ..     (if updat
d540: 65 72 20 28 75 70 64 61 74 65 72 20 6c 61 73 74  er (updater last
d550: 2d 78 61 64 6a 20 6c 61 73 74 2d 79 61 64 6a 29  -xadj last-yadj)
d560: 29 29 29 29 29 29 0a 09 09 09 09 09 09 20 28 68  ))))))....... (h
d570: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 74  ash-table-keys t
d580: 65 73 74 73 2d 69 6e 66 6f 29 29 29 29 29 29 29  ests-info)))))))
d590: 0a 20 20 20 20 20 63 61 6e 76 61 73 2d 6f 62 6a  .     canvas-obj
d5a0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d  )))..;;=========
d5b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
d5c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
d5d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
d5e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b  =============.;;
d5f0: 20 20 53 20 54 20 45 20 50 20 53 0a 3b 3b 3d 3d    S T E P S.;;==
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 3d 3d 3d 3d  ================
d620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
d630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
d640: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64  ====..(define (d
d650: 63 6f 6d 6d 6f 6e 3a 70 6f 70 75 6c 61 74 65 2d  common:populate-
d660: 73 74 65 70 73 20 74 65 73 74 73 74 65 70 73 20  steps teststeps 
d670: 73 74 65 70 73 2d 6d 61 74 72 69 78 20 72 75 6e  steps-matrix run
d680: 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28  -id test-id).  (
d690: 6c 65 74 2a 20 28 28 6d 61 78 2d 72 6f 77 20 20  let* ((max-row  
d6a0: 20 20 20 20 20 30 29 0a 09 20 28 6d 61 78 2d 63       0).. (max-c
d6b0: 6f 6c 20 20 20 20 20 20 20 39 29 0a 20 20 20 20  ol       9).    
d6c0: 20 20 20 20 20 28 77 68 69 74 65 20 20 20 20 20       (white     
d6d0: 20 20 20 20 22 32 35 35 20 32 35 35 20 32 35 35      "255 255 255
d6e0: 22 29 0a 20 20 20 20 20 20 20 20 20 0a 20 20 20  ").         .   
d6f0: 20 20 20 20 20 20 28 74 65 73 74 69 6e 66 6f 20        (testinfo 
d700: 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 65       (rmt:get-te
d710: 73 74 69 6e 66 6f 2d 73 74 61 74 65 2d 73 74 61  stinfo-state-sta
d720: 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d  tus run-id test-
d730: 69 64 29 29 0a 20 20 20 20 20 20 20 20 20 28 73  id)).         (s
d740: 74 61 74 65 20 20 20 20 20 20 20 20 20 28 64 62  tate         (db
d750: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20  :test-get-state 
d760: 74 65 73 74 69 6e 66 6f 29 29 0a 20 20 20 20 20  testinfo)).     
d770: 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 20      (status     
d780: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d     (db:test-get-
d790: 73 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29  status testinfo)
d7a0: 29 0a 20 20 20 20 20 20 20 20 20 28 74 65 73 74  ).         (test
d7b0: 2d 73 74 61 74 75 73 2d 63 6f 6c 6f 72 20 28 63  -status-color (c
d7c0: 61 72 20 28 67 75 74 69 6c 73 3a 67 65 74 2d 63  ar (gutils:get-c
d7d0: 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73  olor-for-state-s
d7e0: 74 61 74 75 73 20 73 74 61 74 65 20 73 74 61 74  tatus state stat
d7f0: 75 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 28  us))).         (
d800: 72 75 6e 6e 69 6e 67 2d 63 6f 6c 6f 72 20 28 63  running-color (c
d810: 61 72 20 28 67 75 74 69 6c 73 3a 67 65 74 2d 63  ar (gutils:get-c
d820: 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73  olor-for-state-s
d830: 74 61 74 75 73 20 22 52 55 4e 4e 49 4e 47 22 20  tatus "RUNNING" 
d840: 22 53 54 41 52 54 45 44 22 29 29 29 0a 20 20 20  "STARTED"))).   
d850: 20 20 20 20 20 20 28 66 61 69 6c 63 6f 6c 6f 72        (failcolor
d860: 20 20 20 20 20 28 63 61 72 20 28 67 75 74 69 6c       (car (gutil
d870: 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d  s:get-color-for-
d880: 73 74 61 74 65 2d 73 74 61 74 75 73 20 22 43 4f  state-status "CO
d890: 4d 50 4c 45 54 45 44 22 20 22 46 41 49 4c 22 29  MPLETED" "FAIL")
d8a0: 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c  ))).    (if (nul
d8b0: 6c 3f 20 74 65 73 74 73 74 65 70 73 29 0a 09 28  l? teststeps)..(
d8c0: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20  begin.          
d8d0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73  (iup:attribute-s
d8e0: 65 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78  et! steps-matrix
d8f0: 20 22 43 4c 45 41 52 41 54 54 52 49 42 22 20 22   "CLEARATTRIB" "
d900: 43 4f 4e 54 45 4e 54 53 22 29 0a 20 20 20 20 20  CONTENTS").     
d910: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62       (iup:attrib
d920: 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d 6d  ute-set! steps-m
d930: 61 74 72 69 78 20 22 43 4c 45 41 52 56 41 4c 55  atrix "CLEARVALU
d940: 45 22 20 22 43 4f 4e 54 45 4e 54 53 22 29 29 0a  E" "CONTENTS")).
d950: 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64  .(let loop ((hed
d960: 20 20 20 20 28 63 61 72 20 74 65 73 74 73 74 65      (car testste
d970: 70 73 29 29 0a 09 09 20 20 20 28 74 61 6c 20 20  ps))...   (tal  
d980: 20 20 28 63 64 72 20 74 65 73 74 73 74 65 70 73    (cdr teststeps
d990: 29 29 0a 09 09 20 20 20 28 72 6f 77 6e 75 6d 20  ))...   (rownum 
d9a0: 31 29 0a 09 09 20 20 20 28 63 6f 6c 6e 75 6d 20  1)...   (colnum 
d9b0: 31 29 29 0a 09 20 20 28 69 66 20 28 3e 20 72 6f  1))..  (if (> ro
d9c0: 77 6e 75 6d 20 6d 61 78 2d 72 6f 77 29 28 73 65  wnum max-row)(se
d9d0: 74 21 20 6d 61 78 2d 72 6f 77 20 72 6f 77 6e 75  t! max-row rownu
d9e0: 6d 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 73  m))..  (let* ((s
d9f0: 74 61 74 75 73 20 20 28 76 65 63 74 6f 72 2d 72  tatus  (vector-r
da00: 65 66 20 68 65 64 20 33 29 29 0a 20 20 20 20 20  ef hed 3)).     
da10: 20 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c              (val
da20: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66       (vector-ref
da30: 20 68 65 64 20 28 2d 20 63 6f 6c 6e 75 6d 20 31   hed (- colnum 1
da40: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  ))).            
da50: 20 20 20 20 20 28 62 67 63 6f 6c 6f 72 20 28 63       (bgcolor (c
da60: 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20  ond.            
da70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
da80: 28 6d 65 6d 62 65 72 20 28 63 6f 6e 63 20 73 74  (member (conc st
da90: 61 74 75 73 29 20 27 28 22 22 20 22 2d 22 20 22  atus) '("" "-" "
daa0: 23 3c 75 6e 73 70 65 63 69 66 69 65 64 3e 22 29  #<unspecified>")
dab0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20  ).              
dac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 75                ru
dad0: 6e 6e 69 6e 67 2d 63 6f 6c 6f 72 29 0a 20 20 20  nning-color).   
dae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
daf0: 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20          .       
db00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
db10: 20 20 20 20 28 28 6d 65 6d 62 65 72 20 28 63 6f      ((member (co
db20: 6e 63 20 73 74 61 74 75 73 29 20 27 28 22 30 22  nc status) '("0"
db30: 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20   0)).           
db40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
db50: 20 77 68 69 74 65 29 0a 20 20 20 20 20 20 20 20   white).        
db60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
db70: 20 20 20 28 65 6c 73 65 20 74 65 73 74 2d 73 74     (else test-st
db80: 61 74 75 73 2d 63 6f 6c 6f 72 29 29 29 0a 20 20  atus-color))).  
db90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
dba0: 20 20 20 20 20 20 20 20 3b 20 28 65 6c 73 65 20          ; (else 
dbb0: 66 61 69 6c 63 6f 6c 6f 72 29 29 29 0a 09 09 20  failcolor)))... 
dbc0: 28 6d 74 72 78 2d 72 63 20 28 63 6f 6e 63 20 72  (mtrx-rc (conc r
dbd0: 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d  ownum ":" colnum
dbe0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  ))).            
dbf0: 3b 3b 28 70 72 69 6e 74 20 22 42 42 3e 20 73 74  ;;(print "BB> st
dc00: 61 74 75 73 3d 3e 22 73 74 61 74 75 73 22 3c 20  atus=>"status"< 
dc10: 62 67 63 6f 6c 6f 72 3d 22 62 67 63 6f 6c 6f 72  bgcolor="bgcolor
dc20: 29 0a 09 20 20 20 20 28 69 75 70 3a 61 74 74 72  )..    (iup:attr
dc30: 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73  ibute-set! steps
dc40: 2d 6d 61 74 72 69 78 20 20 6d 74 72 78 2d 72 63  -matrix  mtrx-rc
dc50: 20 28 69 66 20 76 61 6c 20 28 63 6f 6e 63 20 76   (if val (conc v
dc60: 61 6c 29 20 22 22 29 29 0a 20 20 20 20 20 20 20  al) "")).       
dc70: 20 20 20 20 20 28 69 66 20 28 3c 20 63 6f 6c 6e       (if (< coln
dc80: 75 6d 20 35 29 0a 20 20 20 20 20 20 20 20 20 20  um 5).          
dc90: 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69        (iup:attri
dca0: 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d  bute-set! steps-
dcb0: 6d 61 74 72 69 78 20 20 28 63 6f 6e 63 20 22 42  matrix  (conc "B
dcc0: 47 43 4f 4c 4f 52 22 20 6d 74 72 78 2d 72 63 29  GCOLOR" mtrx-rc)
dcd0: 20 62 67 63 6f 6c 6f 72 29 29 0a 09 20 20 20 20   bgcolor))..    
dce0: 28 69 66 20 28 3c 20 63 6f 6c 6e 75 6d 20 6d 61  (if (< colnum ma
dcf0: 78 2d 63 6f 6c 29 0a 09 09 28 6c 6f 6f 70 20 68  x-col)...(loop h
dd00: 65 64 20 74 61 6c 20 72 6f 77 6e 75 6d 20 28 2b  ed tal rownum (+
dd10: 20 63 6f 6c 6e 75 6d 20 31 29 29 0a 09 09 28 69   colnum 1))...(i
dd20: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61  f (not (null? ta
dd30: 6c 29 29 0a 09 09 20 20 20 20 28 6c 6f 6f 70 20  l))...    (loop 
dd40: 28 63 61 72 20 74 61 6c 29 20 28 63 64 72 20 74  (car tal) (cdr t
dd50: 61 6c 29 20 28 2b 20 72 6f 77 6e 75 6d 20 31 29  al) (+ rownum 1)
dd60: 20 31 29 29 29 29 29 29 0a 20 20 20 20 28 69 66   1)))))).    (if
dd70: 20 28 3e 20 6d 61 78 2d 72 6f 77 20 30 29 0a 09   (> max-row 0)..
dd80: 28 62 65 67 69 6e 0a 09 20 20 3b 3b 20 77 65 20  (begin..  ;; we 
dd90: 61 72 65 20 67 6f 69 6e 67 20 74 6f 20 73 70 65  are going to spe
dda0: 63 75 6c 61 74 69 76 65 6c 79 20 63 6c 65 61 72  culatively clear
ddb0: 20 72 6f 77 73 20 75 6e 74 69 6c 20 77 65 20 66   rows until we f
ddc0: 69 6e 64 20 61 20 72 6f 77 20 74 68 61 74 20 69  ind a row that i
ddd0: 73 20 61 6c 72 65 61 64 79 20 63 6c 65 61 72 65  s already cleare
dde0: 64 0a 09 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28  d..  (let loop (
ddf0: 28 72 6f 77 6e 75 6d 20 20 28 2b 20 6d 61 78 2d  (rownum  (+ max-
de00: 72 6f 77 20 31 29 29 0a 09 09 20 20 20 20 20 28  row 1))...     (
de10: 63 6f 6c 6e 75 6d 20 20 30 29 0a 09 09 20 20 20  colnum  0)...   
de20: 20 20 28 64 65 6c 65 74 65 64 20 23 66 29 29 0a    (deleted #f)).
de30: 09 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70  .    ;; (debug:p
de40: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66  rint-info 0 *def
de50: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22  ault-log-port* "
de60: 63 6c 65 61 6e 69 6e 67 20 22 20 72 6f 77 6e 75  cleaning " rownu
de70: 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 0a 09 20  m ":" colnum).. 
de80: 20 20 20 28 6c 65 74 2a 20 28 28 6e 65 78 74 2d     (let* ((next-
de90: 72 6f 77 20 28 69 66 20 28 65 71 3f 20 63 6f 6c  row (if (eq? col
dea0: 6e 75 6d 20 6d 61 78 2d 63 6f 6c 29 20 28 2b 20  num max-col) (+ 
deb0: 72 6f 77 6e 75 6d 20 31 29 20 72 6f 77 6e 75 6d  rownum 1) rownum
dec0: 29 29 0a 09 09 20 20 20 28 6e 65 78 74 2d 63 6f  ))...   (next-co
ded0: 6c 20 28 69 66 20 28 65 71 3f 20 63 6f 6c 6e 75  l (if (eq? colnu
dee0: 6d 20 6d 61 78 2d 63 6f 6c 29 20 31 20 28 2b 20  m max-col) 1 (+ 
def0: 63 6f 6c 6e 75 6d 20 31 29 29 29 0a 09 09 20 20  colnum 1)))...  
df00: 20 28 6d 74 72 78 2d 72 63 20 20 28 63 6f 6e 63   (mtrx-rc  (conc
df10: 20 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e   rownum ":" coln
df20: 75 6d 29 29 0a 09 09 20 20 20 28 63 75 72 72 2d  um))...   (curr-
df30: 76 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 75  val (iup:attribu
df40: 74 65 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20  te steps-matrix 
df50: 6d 74 72 78 2d 72 63 29 29 29 0a 09 20 20 20 20  mtrx-rc)))..    
df60: 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e    ;; (debug:prin
df70: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c  t-info 0 *defaul
df80: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 6c 65  t-log-port* "cle
df90: 61 6e 69 6e 67 20 22 20 72 6f 77 6e 75 6d 20 22  aning " rownum "
dfa0: 3a 22 20 63 6f 6c 6e 75 6d 20 22 20 63 75 72 72  :" colnum " curr
dfb0: 76 61 6c 3d 20 22 20 63 75 72 72 2d 76 61 6c 29  val= " curr-val)
dfc0: 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64  ..      (if (and
dfd0: 20 28 73 74 72 69 6e 67 3f 20 63 75 72 72 2d 76   (string? curr-v
dfe0: 61 6c 29 0a 09 09 20 20 20 20 20 20 20 28 6e 6f  al)...       (no
dff0: 74 20 28 65 71 75 61 6c 3f 20 63 75 72 72 2d 76  t (equal? curr-v
e000: 61 6c 20 22 22 29 29 29 0a 09 09 20 20 28 62 65  al "")))...  (be
e010: 67 69 6e 0a 09 09 20 20 20 20 28 69 75 70 3a 61  gin...    (iup:a
e020: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74  ttribute-set! st
e030: 65 70 73 2d 6d 61 74 72 69 78 20 6d 74 72 78 2d  eps-matrix mtrx-
e040: 72 63 20 22 22 29 0a 09 09 20 20 20 20 28 6c 6f  rc "")...    (lo
e050: 6f 70 20 6e 65 78 74 2d 72 6f 77 20 6e 65 78 74  op next-row next
e060: 2d 63 6f 6c 20 23 74 29 29 0a 09 09 20 20 28 69  -col #t))...  (i
e070: 66 20 28 65 71 3f 20 63 6f 6c 6e 75 6d 20 6d 61  f (eq? colnum ma
e080: 78 2d 63 6f 6c 29 20 3b 3b 20 6e 6f 74 20 64 6f  x-col) ;; not do
e090: 6e 65 2c 20 64 69 64 6e 27 74 20 67 65 74 20 61  ne, didn't get a
e0a0: 20 66 75 6c 6c 20 62 6c 61 6e 6b 20 72 6f 77 0a   full blank row.
e0b0: 09 09 20 20 20 20 20 20 28 69 66 20 64 65 6c 65  ..      (if dele
e0c0: 74 65 64 20 28 6c 6f 6f 70 20 6e 65 78 74 2d 72  ted (loop next-r
e0d0: 6f 77 20 6e 65 78 74 2d 63 6f 6c 20 23 66 29 29  ow next-col #f))
e0e0: 20 3b 3b 20 65 78 69 74 20 6f 6e 20 74 68 69 73   ;; exit on this
e0f0: 20 6e 6f 74 20 6d 65 74 0a 09 09 20 20 20 20 20   not met...     
e100: 20 28 6c 6f 6f 70 20 6e 65 78 74 2d 72 6f 77 20   (loop next-row 
e110: 6e 65 78 74 2d 63 6f 6c 20 64 65 6c 65 74 65 64  next-col deleted
e120: 29 29 29 29 29 0a 09 20 20 28 69 75 70 3a 61 74  )))))..  (iup:at
e130: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65  tribute-set! ste
e140: 70 73 2d 6d 61 74 72 69 78 20 22 52 45 44 52 41  ps-matrix "REDRA
e150: 57 22 20 22 41 4c 4c 22 29 29 29 29 29 0a 0a 3b  W" "ALL")))))..;
e160: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ;===============
e170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
e180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
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 0a 3b 3b 20 55 20 54 20 49  =======.;; U T I
e1b0: 20 4c 20 49 20 54 20 49 20 45 20 53 0a 3b 3b 3d   L I T I E S.;;=
e1c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
e1d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
e1e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
e1f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d  ================
e200: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28  =====..(define (
e210: 64 63 6f 6d 6d 6f 6e 3a 72 75 6e 2d 68 74 6d 6c  dcommon:run-html
e220: 2d 76 69 65 77 65 72 20 6c 66 69 6c 65 6e 61 6d  -viewer lfilenam
e230: 65 29 0a 20 20 28 6c 65 74 20 28 28 68 74 6d 6c  e).  (let ((html
e240: 76 69 65 77 65 72 63 6d 64 20 28 63 6f 6e 66 69  viewercmd (confi
e250: 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69  gf:lookup *confi
e260: 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 68  gdat* "setup" "h
e270: 74 6d 6c 76 69 65 77 65 72 63 6d 64 22 29 29 29  tmlviewercmd")))
e280: 0a 20 20 20 20 28 69 66 20 68 74 6d 6c 76 69 65  .    (if htmlvie
e290: 77 65 72 63 6d 64 0a 09 28 73 79 73 74 65 6d 20  wercmd..(system 
e2a0: 28 63 6f 6e 63 20 22 28 22 20 68 74 6d 6c 76 69  (conc "(" htmlvi
e2b0: 65 77 65 72 63 6d 64 20 22 20 22 20 6c 66 69 6c  ewercmd " " lfil
e2c0: 65 6e 61 6d 65 20 22 20 29 20 26 22 29 29 20 0a  ename " ) &")) .
e2d0: 09 28 69 75 70 3a 73 65 6e 64 2d 75 72 6c 20 6c  .(iup:send-url l
e2e0: 66 69 6c 65 6e 61 6d 65 29 29 29 29 0a 0a        filename))))..