Artifact
fbdcd8eb79f3e036a50ccc83fef9874b1853c896:
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 3b 3b 20 ===========..;;
0390: 79 65 73 2c 20 74 68 69 73 20 69 73 20 6e 6f 6e yes, this is non
03a0: 2d 69 64 65 61 6c 20 0a 28 64 65 66 69 6e 65 20 -ideal .(define
03b0: 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 dashboard:update
03c0: 2d 73 75 6d 6d 61 72 79 2d 74 61 62 20 23 66 29 -summary-tab #f)
03d0: 0a 28 64 65 66 69 6e 65 20 64 61 73 68 62 6f 61 .(define dashboa
03e0: 72 64 3a 75 70 64 61 74 65 2d 73 65 72 76 65 72 rd:update-server
03f0: 73 2d 74 61 62 6c 65 20 23 66 29 0a 0a 28 64 65 s-table #f)..(de
0400: 66 69 6e 65 20 28 63 6f 6d 6d 6f 6e 3a 72 75 6e fine (common:run
0410: 2d 61 2d 63 6f 6d 6d 61 6e 64 20 63 6d 64 20 23 -a-command cmd #
0420: 21 6b 65 79 20 28 77 69 74 68 2d 76 61 72 73 20 !key (with-vars
0430: 23 66 29 20 28 77 69 74 68 2d 6f 72 69 67 2d 65 #f) (with-orig-e
0440: 6e 76 20 23 66 29 29 0a 20 20 28 6c 65 74 2a 20 nv #f)). (let*
0450: 28 28 70 72 65 2d 63 6d 64 20 20 28 64 74 65 73 ((pre-cmd (dtes
0460: 74 73 3a 67 65 74 2d 70 72 65 2d 63 6f 6d 6d 61 ts:get-pre-comma
0470: 6e 64 29 29 0a 20 20 20 20 20 20 20 20 20 28 70 nd)). (p
0480: 6f 73 74 2d 63 6d 64 20 28 64 74 65 73 74 73 3a ost-cmd (dtests:
0490: 67 65 74 2d 70 6f 73 74 2d 63 6f 6d 6d 61 6e 64 get-post-command
04a0: 29 29 0a 20 20 20 20 20 20 20 20 20 28 66 75 6c )). (ful
04b0: 6c 63 6d 64 20 20 28 69 66 20 28 6f 72 20 70 72 lcmd (if (or pr
04c0: 65 2d 63 6d 64 20 70 6f 73 74 2d 63 6d 64 29 0a e-cmd post-cmd).
04d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
04e0: 20 20 20 20 20 20 20 28 63 6f 6e 63 20 70 72 65 (conc pre
04f0: 2d 63 6d 64 20 63 6d 64 20 70 6f 73 74 2d 63 6d -cmd cmd post-cm
0500: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
0510: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 (conc
0520: 22 76 69 65 77 73 63 72 65 65 6e 20 22 20 63 6d "viewscreen " cm
0530: 64 29 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 d)))). (debug
0540: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 32 20 2a :print-info 02 *
0550: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
0560: 2a 20 22 52 75 6e 6e 69 6e 67 20 63 6f 6d 6d 61 * "Running comma
0570: 6e 64 3a 20 22 20 66 75 6c 6c 63 6d 64 29 0a 20 nd: " fullcmd).
0580: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 77 (cond. (w
0590: 69 74 68 2d 76 61 72 73 20 20 20 20 20 28 63 6f ith-vars (co
05a0: 6d 6d 6f 6e 3a 77 69 74 68 6f 75 74 2d 76 61 72 mmon:without-var
05b0: 73 20 20 66 75 6c 6c 63 6d 64 29 29 0a 20 20 20 s fullcmd)).
05c0: 20 20 28 77 69 74 68 2d 6f 72 69 67 2d 65 6e 76 (with-orig-env
05d0: 20 28 63 6f 6d 6d 6f 6e 3a 77 69 74 68 2d 6f 72 (common:with-or
05e0: 69 67 2d 65 6e 76 20 66 75 6c 6c 63 6d 64 29 29 ig-env fullcmd))
05f0: 0a 20 20 20 20 20 28 65 6c 73 65 20 20 20 20 20 . (else
0600: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 77 69 74 (common:wit
0610: 68 6f 75 74 2d 76 61 72 73 20 20 66 75 6c 6c 63 hout-vars fullc
0620: 6d 64 20 22 4d 54 5f 2e 2a 22 29 29 29 29 29 0a md "MT_.*"))))).
0630: 09 09 20 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d .. .;;=========
0640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
0680: 20 43 20 4f 20 4d 20 4d 20 4f 20 4e 20 20 20 44 C O M M O N D
0690: 20 41 20 54 20 41 20 20 20 53 20 54 20 52 20 55 A T A S T R U
06a0: 20 43 20 54 20 55 20 52 20 45 0a 3b 3b 3d 3d 3d C T U R 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 3d 3d 3d 3d 3d 3d ================
06f0: 3d 3d 3d 0a 3b 3b 20 0a 3b 3b 20 64 61 74 61 20 ===.;; .;; data
0700: 63 6f 6d 6d 6f 6e 20 74 6f 20 61 6c 6c 20 74 61 common to all ta
0710: 62 73 20 67 6f 65 73 20 68 65 72 65 0a 3b 3b 0a bs goes here.;;.
0720: 28 64 65 66 73 74 72 75 63 74 20 64 62 6f 61 72 (defstruct dboar
0730: 64 3a 63 6f 6d 6d 6f 6e 64 61 74 0a 20 20 28 28 d:commondat. ((
0740: 63 75 72 72 2d 74 61 62 2d 6e 75 6d 20 30 29 20 curr-tab-num 0)
0750: 3a 20 6e 75 6d 62 65 72 29 0a 20 20 70 6c 65 61 : number). plea
0760: 73 65 2d 75 70 64 61 74 65 20 20 0a 20 20 74 61 se-update . ta
0770: 62 64 61 74 73 0a 20 20 75 70 64 61 74 65 2d 6d bdats. update-m
0780: 75 74 65 78 0a 20 20 75 70 64 61 74 65 72 73 20 utex. updaters
0790: 0a 20 20 75 70 64 61 74 69 6e 67 0a 20 20 75 69 . updating. ui
07a0: 64 61 74 20 3b 3b 20 6e 65 65 64 73 20 74 6f 20 dat ;; needs to
07b0: 6d 6f 76 65 20 74 6f 20 74 61 62 64 61 74 20 61 move to tabdat a
07c0: 74 20 73 6f 6d 65 20 74 69 6d 65 0a 20 20 68 69 t some time. hi
07d0: 64 65 2d 6e 6f 74 2d 68 69 64 65 2d 74 61 62 73 de-not-hide-tabs
07e0: 0a 20 20 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 . )..(define (d
07f0: 62 6f 61 72 64 3a 63 6f 6d 6d 6f 6e 64 61 74 2d board:commondat-
0800: 6d 61 6b 65 29 0a 20 20 28 6d 61 6b 65 2d 64 62 make). (make-db
0810: 6f 61 72 64 3a 63 6f 6d 6d 6f 6e 64 61 74 0a 20 oard:commondat.
0820: 20 20 63 75 72 72 2d 74 61 62 2d 6e 75 6d 3a 20 curr-tab-num:
0830: 20 20 20 20 20 20 20 20 30 0a 20 20 20 74 61 62 0. tab
0840: 64 61 74 73 3a 20 20 20 20 20 20 20 20 20 20 20 dats:
0850: 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 (make-hash-ta
0860: 62 6c 65 29 0a 20 20 20 70 6c 65 61 73 65 2d 75 ble). please-u
0870: 70 64 61 74 65 3a 20 20 20 20 20 20 20 20 23 74 pdate: #t
0880: 0a 20 20 20 75 70 64 61 74 65 2d 6d 75 74 65 78 . update-mutex
0890: 3a 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d : (make-
08a0: 6d 75 74 65 78 29 0a 20 20 20 75 70 64 61 74 65 mutex). update
08b0: 72 73 3a 20 20 20 20 20 20 20 20 20 20 20 20 20 rs:
08c0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
08d0: 29 0a 20 20 20 75 70 64 61 74 69 6e 67 3a 20 20 ). updating:
08e0: 20 20 20 20 20 20 20 20 20 20 20 23 66 0a 20 20 #f.
08f0: 20 68 69 64 65 2d 6e 6f 74 2d 68 69 64 65 2d 74 hide-not-hide-t
0900: 61 62 73 3a 20 20 20 23 66 0a 20 20 20 29 29 0a abs: #f. )).
0910: 0a 3b 3b 20 52 41 44 54 20 3d 3e 20 4d 61 74 72 .;; RADT => Matr
0920: 69 78 20 64 65 66 73 74 72 75 63 74 20 61 64 64 ix defstruct add
0930: 69 74 69 6f 6e 0a 28 64 65 66 73 74 72 75 63 74 ition.(defstruct
0940: 20 64 62 6f 61 72 64 3a 67 72 61 70 68 2d 64 61 dboard:graph-da
0950: 74 0a 20 20 20 20 28 28 69 64 20 20 20 20 20 20 t. ((id
0960: 20 20 20 20 20 23 66 29 20 3a 20 73 74 72 69 6e #f) : strin
0970: 67 29 0a 20 20 20 20 28 28 63 6f 6c 6f 72 20 20 g). ((color
0980: 20 20 20 20 20 20 23 66 29 20 3a 20 76 65 63 74 #f) : vect
0990: 6f 72 29 0a 20 20 20 20 28 28 66 6c 61 67 20 20 or). ((flag
09a0: 20 20 20 20 20 20 20 23 74 29 20 3a 20 62 6f 6f #t) : boo
09b0: 6c 65 61 6e 29 0a 20 20 20 20 28 28 63 65 6c 6c lean). ((cell
09c0: 20 20 20 20 20 20 20 20 20 23 66 29 20 3a 20 6e #f) : n
09d0: 75 6d 62 65 72 29 0a 20 20 20 20 29 0a 0a 3b 3b umber). )..;;
09e0: 20 64 61 74 61 20 66 6f 72 20 72 75 6e 73 2c 20 data for runs,
09f0: 74 65 73 74 73 20 65 74 63 2e 20 77 61 73 20 75 tests etc. was u
0a00: 73 65 64 20 69 6e 20 72 75 6e 20 73 75 6d 6d 61 sed in run summa
0a10: 72 79 3f 0a 3b 3b 0a 28 64 65 66 73 74 72 75 63 ry?.;;.(defstruc
0a20: 74 20 64 62 6f 61 72 64 3a 72 75 6e 73 64 61 74 t dboard:runsdat
0a30: 0a 20 20 3b 3b 20 6e 65 77 20 73 79 73 74 65 6d . ;; new system
0a40: 0a 20 20 72 75 6e 73 2d 69 6e 64 65 78 20 20 20 . runs-index
0a50: 20 3b 3b 20 74 61 72 67 65 74 2f 72 75 6e 6e 61 ;; target/runna
0a60: 6d 65 20 3d 3e 20 63 6f 6c 6e 75 6d 0a 20 20 74 me => colnum. t
0a70: 65 73 74 73 2d 69 6e 64 65 78 20 20 20 3b 3b 20 ests-index ;;
0a80: 74 65 73 74 6e 61 6d 65 2f 69 74 65 6d 70 61 74 testname/itempat
0a90: 68 20 3d 3e 20 72 6f 77 6e 75 6d 0a 20 20 6d 61 h => rownum. ma
0aa0: 74 72 69 78 2d 64 61 74 20 20 20 20 3b 3b 20 76 trix-dat ;; v
0ab0: 65 63 74 6f 72 20 6f 66 20 76 65 63 74 6f 72 73 ector of vectors
0ac0: 20 72 6f 77 73 2f 63 6f 6c 73 0a 20 20 29 0a 0a rows/cols. )..
0ad0: 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 3a (define (dboard:
0ae0: 72 75 6e 73 64 61 74 2d 6d 61 6b 65 2d 69 6e 69 runsdat-make-ini
0af0: 74 29 0a 20 20 28 6d 61 6b 65 2d 64 62 6f 61 72 t). (make-dboar
0b00: 64 3a 72 75 6e 73 64 61 74 0a 20 20 20 72 75 6e d:runsdat. run
0b10: 73 2d 69 6e 64 65 78 3a 20 28 6d 61 6b 65 2d 68 s-index: (make-h
0b20: 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 74 65 ash-table). te
0b30: 73 74 73 2d 69 6e 64 65 78 3a 20 28 6d 61 6b 65 sts-index: (make
0b40: 2d 68 61 73 68 2d 74 61 62 6c 65 29 0a 20 20 20 -hash-table).
0b50: 6d 61 74 72 69 78 2d 64 61 74 3a 20 28 6d 61 6b matrix-dat: (mak
0b60: 65 2d 73 70 61 72 73 65 2d 61 72 72 61 79 29 29 e-sparse-array))
0b70: 29 0a 0a 3b 3b 20 75 73 65 64 20 74 6f 20 6b 65 )..;; used to ke
0b80: 65 70 20 74 68 65 20 72 75 6e 64 61 74 61 20 66 ep the rundata f
0b90: 72 6f 6d 20 72 6d 74 3a 67 65 74 2d 74 65 73 74 rom rmt:get-test
0ba0: 73 2d 66 6f 72 2d 72 75 6e 0a 3b 3b 20 69 6e 20 s-for-run.;; in
0bb0: 73 79 6e 63 2e 20 0a 3b 3b 0a 28 64 65 66 73 74 sync. .;;.(defst
0bc0: 72 75 63 74 20 64 62 6f 61 72 64 3a 72 75 6e 64 ruct dboard:rund
0bd0: 61 74 0a 20 20 72 75 6e 0a 20 20 74 65 73 74 73 at. run. tests
0be0: 2d 64 72 61 77 6e 20 20 20 20 3b 3b 20 6c 69 73 -drawn ;; lis
0bf0: 74 20 6f 66 20 69 64 27 73 20 61 6c 72 65 61 64 t of id's alread
0c00: 79 20 64 72 61 77 6e 20 6f 6e 20 73 63 72 65 65 y drawn on scree
0c10: 6e 0a 20 20 74 65 73 74 73 2d 6e 6f 74 64 72 61 n. tests-notdra
0c20: 77 6e 20 3b 3b 20 6c 69 73 74 20 6f 66 20 69 64 wn ;; list of id
0c30: 27 73 20 4e 4f 54 20 61 6c 72 65 61 64 79 20 64 's NOT already d
0c40: 72 61 77 6e 0a 20 20 72 6f 77 73 75 73 65 64 20 rawn. rowsused
0c50: 20 20 20 20 20 20 3b 3b 20 68 61 73 68 20 6f 66 ;; hash of
0c60: 20 6c 69 73 74 73 20 63 6f 76 65 72 69 6e 67 20 lists covering
0c70: 77 68 61 74 20 61 72 65 61 73 20 75 73 65 64 20 what areas used
0c80: 2d 20 72 65 70 6c 61 63 65 20 77 69 74 68 20 71 - replace with q
0c90: 75 61 64 74 72 65 65 0a 20 20 68 69 65 72 64 61 uadtree. hierda
0ca0: 74 20 20 20 20 20 20 20 20 3b 3b 20 70 75 74 20 t ;; put
0cb0: 68 69 65 72 61 72 63 68 69 61 6c 20 73 6f 72 74 hierarchial sort
0cc0: 65 64 20 6c 69 73 74 20 68 65 72 65 0a 20 20 74 ed list here. t
0cd0: 65 73 74 73 20 20 20 20 20 20 20 20 20 20 3b 3b ests ;;
0ce0: 20 68 61 73 68 20 6f 66 20 69 64 20 3d 3e 20 74 hash of id => t
0cf0: 65 73 74 64 61 74 0a 20 20 28 28 74 65 73 74 73 estdat. ((tests
0d00: 2d 62 79 2d 6e 61 6d 65 20 28 6d 61 6b 65 2d 68 -by-name (make-h
0d10: 61 73 68 2d 74 61 62 6c 65 29 29 20 3a 20 68 61 ash-table)) : ha
0d20: 73 68 2d 74 61 62 6c 65 29 20 3b 3b 20 68 61 73 sh-table) ;; has
0d30: 68 20 6f 66 20 74 65 73 74 66 75 6c 6c 6e 61 6d h of testfullnam
0d40: 65 20 3d 3e 20 74 65 73 74 64 61 74 0a 20 20 6b e => testdat. k
0d50: 65 79 2d 76 61 6c 73 0a 20 20 28 28 6c 61 73 74 ey-vals. ((last
0d60: 2d 75 70 64 61 74 65 20 20 20 30 29 20 20 20 20 -update 0)
0d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6e : n
0d80: 75 6d 62 65 72 29 20 20 20 20 3b 3b 20 6c 61 73 umber) ;; las
0d90: 74 20 71 75 65 72 79 20 74 6f 20 64 62 20 67 6f t query to db go
0da0: 74 20 72 65 63 6f 72 64 73 20 66 72 6f 6d 20 62 t records from b
0db0: 65 66 6f 72 65 20 6c 61 73 74 2d 75 70 64 61 74 efore last-updat
0dc0: 65 0a 20 20 28 28 6c 61 73 74 2d 64 62 2d 74 69 e. ((last-db-ti
0dd0: 6d 65 20 20 30 29 20 20 20 20 20 20 20 20 20 20 me 0)
0de0: 20 20 20 20 20 20 20 3a 20 6e 75 6d 62 65 72 29 : number)
0df0: 20 20 20 20 3b 3b 20 6c 61 73 74 20 74 69 6d 65 ;; last time
0e00: 73 74 61 6d 70 20 6f 6e 20 6d 65 67 61 74 65 73 stamp on megates
0e10: 74 2e 64 62 0a 20 20 28 28 64 61 74 61 2d 63 68 t.db. ((data-ch
0e20: 61 6e 67 65 64 20 20 23 66 29 20 20 20 20 20 20 anged #f)
0e30: 20 20 20 20 20 20 20 20 20 20 3a 20 62 6f 6f 6c : bool
0e40: 65 61 6e 29 20 20 20 0a 20 20 28 28 72 75 6e 2d ean) . ((run-
0e50: 64 61 74 61 2d 6f 66 66 73 65 74 20 20 30 29 20 data-offset 0)
0e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 3a 20 6e : n
0e70: 75 6d 62 65 72 29 20 20 20 20 20 20 3b 3b 20 67 umber) ;; g
0e80: 65 74 20 6f 6e 6c 79 20 31 30 30 20 69 74 65 6d et only 100 item
0e90: 73 20 70 65 72 20 63 61 6c 6c 2c 20 73 65 74 20 s per call, set
0ea0: 62 61 63 6b 20 74 6f 20 7a 65 72 6f 20 77 68 65 back to zero whe
0eb0: 6e 20 72 65 63 65 69 76 65 64 20 6c 65 73 73 20 n received less
0ec0: 74 68 61 6e 20 31 30 30 20 69 74 65 6d 73 0a 20 than 100 items.
0ed0: 20 28 64 62 2d 70 61 74 68 20 23 66 29 29 0a 0a (db-path #f))..
0ee0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
0ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 44 20 4f =========.;; D O
0f30: 20 54 20 46 20 49 20 4c 20 45 0a 3b 3b 3d 3d 3d T F I L E.;;===
0f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0f80: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 ===..(define (dc
0f90: 6f 6d 6d 6f 6e 3a 77 72 69 74 65 2d 64 6f 74 66 ommon:write-dotf
0fa0: 69 6c 65 20 66 6e 61 6d 65 20 64 61 74 29 0a 20 ile fname dat).
0fb0: 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f (with-output-to
0fc0: 2d 66 69 6c 65 20 66 6e 61 6d 65 0a 20 20 20 20 -file fname.
0fd0: 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 (lambda ().
0fe0: 20 28 70 70 20 64 61 74 29 29 29 29 0a 0a 3b 3b (pp dat))))..;;
0ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1030: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 41 52 47 45 54 ======.;; TARGET
1040: 20 41 4e 44 20 50 41 54 54 45 52 4e 20 4d 41 4e AND PATTERN MAN
1050: 49 50 55 4c 41 54 49 4f 4e 53 0a 3b 3b 3d 3d 3d IPULATIONS.;;===
1060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a0: 3d 3d 3d 0a 0a 3b 3b 20 43 6f 6e 76 65 72 74 20 ===..;; Convert
10b0: 74 6f 20 61 6e 64 20 66 72 6f 6d 20 6c 69 73 74 to and from list
10c0: 20 6f 66 20 6c 69 6e 65 73 20 28 66 6f 72 20 61 of lines (for a
10d0: 20 74 65 78 74 20 62 6f 78 29 0a 3b 3b 20 22 2c text box).;; ",
10e0: 22 20 3d 3e 20 22 5c 6e 22 0a 28 64 65 66 69 6e " => "\n".(defin
10f0: 65 20 28 64 62 6f 61 72 64 3a 74 65 73 74 2d 70 e (dboard:test-p
1100: 61 74 74 2d 3e 6c 69 6e 65 73 20 74 65 73 74 2d att->lines test-
1110: 70 61 74 74 29 0a 20 20 28 73 74 72 69 6e 67 2d patt). (string-
1120: 73 75 62 73 74 69 74 75 74 65 20 28 72 65 67 65 substitute (rege
1130: 78 70 20 22 2c 22 29 20 22 5c 6e 22 20 74 65 73 xp ",") "\n" tes
1140: 74 2d 70 61 74 74 29 29 0a 0a 28 64 65 66 69 6e t-patt))..(defin
1150: 65 20 28 64 62 6f 61 72 64 3a 6c 69 6e 65 73 2d e (dboard:lines-
1160: 3e 74 65 73 74 2d 70 61 74 74 20 6c 69 6e 65 73 >test-patt lines
1170: 29 0a 20 20 28 73 74 72 69 6e 67 2d 73 75 62 73 ). (string-subs
1180: 74 69 74 75 74 65 20 28 72 65 67 65 78 70 20 22 titute (regexp "
1190: 5c 6e 22 29 20 22 2c 22 20 6c 69 6e 65 73 20 23 \n") "," lines #
11a0: 74 29 29 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d t))...;;========
11b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
11f0: 3b 20 50 20 52 20 4f 20 43 20 45 20 53 20 53 20 ; P R O C E S S
1200: 20 20 52 20 55 20 4e 20 53 0a 3b 3b 3d 3d 3d 3d R U N S.;;====
1210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1250: 3d 3d 0a 0a 3b 3b 20 4d 4f 56 45 20 54 48 49 53 ==..;; MOVE THIS
1260: 20 49 4e 54 4f 20 2a 64 61 74 61 2a 0a 28 64 65 INTO *data*.(de
1270: 66 69 6e 65 20 2a 63 61 63 68 65 64 61 74 61 2a fine *cachedata*
1280: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
1290: 65 29 29 0a 28 68 61 73 68 2d 74 61 62 6c 65 2d e)).(hash-table-
12a0: 73 65 74 21 20 2a 63 61 63 68 65 64 61 74 61 2a set! *cachedata*
12b0: 20 22 72 75 6e 69 64 2d 74 6f 2d 63 6f 6c 22 20 "runid-to-col"
12c0: 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 (make-hash-ta
12d0: 62 6c 65 29 29 0a 28 68 61 73 68 2d 74 61 62 6c ble)).(hash-tabl
12e0: 65 2d 73 65 74 21 20 2a 63 61 63 68 65 64 61 74 e-set! *cachedat
12f0: 61 2a 20 22 74 65 73 74 6e 61 6d 65 2d 74 6f 2d a* "testname-to-
1300: 72 6f 77 22 20 28 6d 61 6b 65 2d 68 61 73 68 2d row" (make-hash-
1310: 74 61 62 6c 65 29 29 0a 0a 3b 3b 20 6d 6f 64 69 table))..;; modi
1320: 66 79 20 61 20 63 65 6c 6c 20 69 66 20 74 68 65 fy a cell if the
1330: 20 64 61 74 61 20 69 73 20 63 68 61 6e 67 65 64 data is changed
1340: 2c 20 72 65 74 75 72 6e 20 23 74 20 6f 72 2d 65 , return #t or-e
1350: 64 20 77 69 74 68 20 70 72 65 76 69 6f 75 73 20 d with previous
1360: 69 66 20 6d 6f 64 69 66 69 65 64 2c 20 23 66 20 if modified, #f
1370: 65 6c 73 65 77 69 73 65 0a 3b 3b 0a 28 64 65 66 elsewise.;;.(def
1380: 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 6d 6f 64 ine (dcommon:mod
1390: 69 66 69 79 2d 69 66 2d 64 69 66 66 65 72 65 6e ifiy-if-differen
13a0: 74 20 6d 74 72 78 20 63 65 6c 6c 2d 6e 61 6d 65 t mtrx cell-name
13b0: 20 6e 65 77 2d 76 61 6c 20 70 72 65 76 2d 63 68 new-val prev-ch
13c0: 61 6e 67 65 64 29 0a 20 20 28 6c 65 74 20 28 28 anged). (let ((
13d0: 63 75 72 72 2d 76 61 6c 20 28 69 75 70 3a 61 74 curr-val (iup:at
13e0: 74 72 69 62 75 74 65 20 6d 74 72 78 20 63 65 6c tribute mtrx cel
13f0: 6c 2d 6e 61 6d 65 29 29 29 0a 20 20 20 20 28 69 l-name))). (i
1400: 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 63 f (not (equal? c
1410: 75 72 72 2d 76 61 6c 20 6e 65 77 2d 76 61 6c 29 urr-val new-val)
1420: 29 20 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 69 ) ..(begin.. (i
1430: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
1440: 21 20 6d 74 72 78 20 63 65 6c 6c 2d 6e 61 6d 65 ! mtrx cell-name
1450: 20 6e 65 77 2d 76 61 6c 29 20 3b 3b 20 77 61 73 new-val) ;; was
1460: 20 63 6f 6c 2d 6e 61 6d 65 0a 09 20 20 23 74 29 col-name.. #t)
1470: 20 3b 3b 20 6e 65 65 64 20 61 20 72 65 2d 64 72 ;; need a re-dr
1480: 61 77 0a 09 70 72 65 76 2d 63 68 61 6e 67 65 64 aw..prev-changed
1490: 29 29 29 0a 0a 0a 3b 3b 20 54 4f 2d 44 4f 0a 3b )))...;; TO-DO.;
14a0: 3b 20 20 31 2e 20 4d 61 6b 65 20 22 64 61 74 61 ; 1. Make "data
14b0: 22 20 68 61 73 68 2d 74 61 62 6c 65 20 68 69 65 " hash-table hie
14c0: 72 61 72 63 68 69 61 6c 20 73 74 6f 72 65 20 6f rarchial store o
14d0: 66 20 61 6c 6c 20 64 69 73 70 6c 61 79 65 64 20 f all displayed
14e0: 64 61 74 61 0a 3b 3b 20 20 32 2e 20 55 70 64 61 data.;; 2. Upda
14f0: 74 65 20 73 79 6e 63 68 61 73 68 20 74 6f 20 75 te synchash to u
1500: 6e 64 65 72 73 74 61 6e 64 20 22 67 65 74 2d 72 nderstand "get-r
1510: 75 6e 73 22 2c 20 22 67 65 74 2d 74 65 73 74 73 uns", "get-tests
1520: 22 20 65 74 63 2e 0a 3b 3b 20 20 33 2e 20 41 64 " etc..;; 3. Ad
1530: 64 20 65 78 74 72 61 63 74 69 6f 6e 20 6f 66 20 d extraction of
1540: 66 69 6c 74 65 72 73 20 74 6f 20 73 79 6e 63 68 filters to synch
1550: 61 73 68 20 63 61 6c 6c 73 0a 3b 3b 0a 3b 3b 20 ash calls.;;.;;
1560: 20 20 20 4e 4f 54 45 3a 20 55 73 65 64 20 69 6e NOTE: Used in
1570: 20 6e 65 77 64 61 73 68 62 6f 61 72 64 0a 3b 3b newdashboard.;;
1580: 0a 3b 3b 20 4d 6f 64 65 20 69 73 20 27 66 75 6c .;; Mode is 'ful
1590: 6c 20 6f 72 20 27 69 6e 63 72 65 6d 65 6e 74 61 l or 'incrementa
15a0: 6c 20 66 6f 72 20 66 75 6c 6c 20 72 65 66 72 65 l for full refre
15b0: 73 68 20 6f 72 20 69 6e 63 72 65 6d 65 6e 74 61 sh or incrementa
15c0: 6c 20 72 65 66 72 65 73 68 0a 3b 3b 20 28 64 65 l refresh.;; (de
15d0: 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 72 75 fine (dcommon:ru
15e0: 6e 2d 75 70 64 61 74 65 20 6b 65 79 73 20 64 61 n-update keys da
15f0: 74 61 20 72 75 6e 6e 61 6d 65 20 6b 65 79 70 61 ta runname keypa
1600: 74 74 73 20 74 65 73 74 70 61 74 74 20 73 74 61 tts testpatt sta
1610: 74 65 73 20 73 74 61 74 75 73 65 73 20 6d 6f 64 tes statuses mod
1620: 65 20 77 69 6e 64 6f 77 2d 69 64 29 0a 3b 3b 20 e window-id).;;
1630: 20 20 28 6c 65 74 2a 20 28 3b 3b 20 63 6f 75 6e (let* (;; coun
1640: 74 20 61 6e 64 20 6f 66 66 73 65 74 20 3d 3e 20 t and offset =>
1650: 23 66 20 73 6f 20 6e 6f 74 20 75 73 65 64 0a 3b #f so not used.;
1660: 3b 20 09 20 3b 3b 20 74 68 65 20 73 79 6e 63 68 ; . ;; the synch
1670: 61 73 68 20 63 61 6c 6c 73 20 6d 6f 64 69 66 79 ash calls modify
1680: 20 74 68 65 20 22 64 61 74 61 22 20 68 61 73 68 the "data" hash
1690: 0a 3b 3b 20 09 20 28 63 68 61 6e 67 65 64 20 20 .;; . (changed
16a0: 20 20 20 20 20 20 20 23 66 29 0a 3b 3b 20 09 20 #f).;; .
16b0: 28 67 65 74 2d 72 75 6e 73 2d 73 69 67 20 20 20 (get-runs-sig
16c0: 20 28 63 6f 6e 63 20 28 63 6c 69 65 6e 74 3a 67 (conc (client:g
16d0: 65 74 2d 73 69 67 6e 61 74 75 72 65 29 20 22 20 et-signature) "
16e0: 67 65 74 2d 72 75 6e 73 22 29 29 0a 3b 3b 20 09 get-runs")).;; .
16f0: 20 28 67 65 74 2d 74 65 73 74 73 2d 73 69 67 20 (get-tests-sig
1700: 20 20 28 63 6f 6e 63 20 28 63 6c 69 65 6e 74 3a (conc (client:
1710: 67 65 74 2d 73 69 67 6e 61 74 75 72 65 29 20 22 get-signature) "
1720: 20 67 65 74 2d 74 65 73 74 73 22 29 29 0a 3b 3b get-tests")).;;
1730: 20 09 20 28 67 65 74 2d 64 65 74 61 69 6c 73 2d . (get-details-
1740: 73 69 67 20 28 63 6f 6e 63 20 28 63 6c 69 65 6e sig (conc (clien
1750: 74 3a 67 65 74 2d 73 69 67 6e 61 74 75 72 65 29 t:get-signature)
1760: 20 22 20 67 65 74 2d 74 65 73 74 2d 64 65 74 61 " get-test-deta
1770: 69 6c 73 22 29 29 0a 3b 3b 20 0a 3b 3b 20 09 20 ils")).;; .;; .
1780: 3b 3b 20 74 65 73 74 2d 69 64 73 20 74 6f 20 67 ;; test-ids to g
1790: 65 74 20 61 6e 64 20 64 69 73 70 6c 61 79 20 61 et and display a
17a0: 72 65 20 69 6e 64 65 78 65 64 20 6f 6e 20 77 69 re indexed on wi
17b0: 6e 64 6f 77 2d 69 64 20 69 6e 20 63 75 72 72 2d ndow-id in curr-
17c0: 74 65 73 74 2d 69 64 73 20 68 61 73 68 0a 3b 3b test-ids hash.;;
17d0: 20 09 20 28 74 65 73 74 2d 69 64 73 20 20 20 20 . (test-ids
17e0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
17f0: 76 61 6c 75 65 73 20 28 64 62 6f 61 72 64 3a 74 values (dboard:t
1800: 61 62 64 61 74 2d 63 75 72 72 2d 74 65 73 74 2d abdat-curr-test-
1810: 69 64 73 20 64 61 74 61 29 29 29 0a 3b 3b 20 09 ids data))).;; .
1820: 20 3b 3b 20 72 75 6e 2d 69 64 20 69 73 20 23 66 ;; run-id is #f
1830: 20 69 6e 20 6e 65 78 74 20 6c 69 6e 65 20 74 6f in next line to
1840: 20 73 65 6e 64 20 74 68 65 20 71 75 65 72 79 20 send the query
1850: 74 6f 20 73 65 72 76 65 72 20 30 0a 3b 3b 20 20 to server 0.;;
1860: 09 20 28 72 75 6e 2d 63 68 61 6e 67 65 73 20 20 . (run-changes
1870: 20 20 20 28 73 79 6e 63 68 61 73 68 3a 63 6c 69 (synchash:cli
1880: 65 6e 74 2d 67 65 74 20 27 64 62 3a 67 65 74 2d ent-get 'db:get-
1890: 72 75 6e 73 20 67 65 74 2d 72 75 6e 73 2d 73 69 runs get-runs-si
18a0: 67 20 28 6c 65 6e 67 74 68 20 6b 65 79 70 61 74 g (length keypat
18b0: 74 73 29 20 64 61 74 61 20 23 66 20 72 75 6e 6e ts) data #f runn
18c0: 61 6d 65 20 23 66 20 23 66 20 6b 65 79 70 61 74 ame #f #f keypat
18d0: 74 73 29 29 0a 3b 3b 20 09 20 28 74 65 73 74 73 ts)).;; . (tests
18e0: 2d 64 65 74 61 69 6c 2d 63 68 61 6e 67 65 73 20 -detail-changes
18f0: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
1900: 74 65 73 74 2d 69 64 73 29 29 0a 3b 3b 20 09 09 test-ids)).;; ..
1910: 09 09 20 20 20 28 73 79 6e 63 68 61 73 68 3a 63 .. (synchash:c
1920: 6c 69 65 6e 74 2d 67 65 74 20 27 64 62 3a 67 65 lient-get 'db:ge
1930: 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 t-test-info-by-i
1940: 64 73 20 67 65 74 2d 64 65 74 61 69 6c 73 2d 73 ds get-details-s
1950: 69 67 20 30 20 20 64 61 74 61 20 23 66 20 74 65 ig 0 data #f te
1960: 73 74 2d 69 64 73 29 0a 3b 3b 20 09 09 09 09 20 st-ids).;; ....
1970: 20 20 27 28 29 29 29 0a 3b 3b 20 0a 3b 3b 20 09 '())).;; .;; .
1980: 20 3b 3b 20 4e 6f 77 20 63 61 6e 20 63 61 6c 63 ;; Now can calc
1990: 75 6c 61 74 65 20 74 68 65 20 72 75 6e 2d 69 64 ulate the run-id
19a0: 73 0a 3b 3b 20 09 20 28 72 75 6e 2d 68 61 73 68 s.;; . (run-hash
19b0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
19c0: 72 65 66 2f 64 65 66 61 75 6c 74 20 64 61 74 61 ref/default data
19d0: 20 67 65 74 2d 72 75 6e 73 2d 73 69 67 20 23 66 get-runs-sig #f
19e0: 29 29 0a 3b 3b 20 09 20 28 72 75 6e 2d 69 64 73 )).;; . (run-ids
19f0: 20 20 20 20 20 28 69 66 20 72 75 6e 2d 68 61 73 (if run-has
1a00: 68 20 28 66 69 6c 74 65 72 20 6e 75 6d 62 65 72 h (filter number
1a10: 3f 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 ? (hash-table-ke
1a20: 79 73 20 72 75 6e 2d 68 61 73 68 29 29 20 27 28 ys run-hash)) '(
1a30: 29 29 29 0a 3b 3b 20 0a 3b 3b 20 09 20 28 61 6c ))).;; .;; . (al
1a40: 6c 2d 74 65 73 74 2d 63 68 61 6e 67 65 73 20 28 l-test-changes (
1a50: 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 2d let ((res (make-
1a60: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 3b 3b hash-table))).;;
1a70: 20 09 09 09 20 20 20 20 20 28 66 6f 72 2d 65 61 ... (for-ea
1a80: 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d ch (lambda (run-
1a90: 69 64 29 0a 3b 3b 20 09 09 09 09 09 20 28 69 66 id).;; ..... (if
1aa0: 20 28 3e 20 72 75 6e 2d 69 64 20 30 29 0a 3b 3b (> run-id 0).;;
1ab0: 20 09 09 09 09 09 20 20 20 20 20 28 68 61 73 68 ..... (hash
1ac0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 73 20 -table-set! res
1ad0: 72 75 6e 2d 69 64 20 28 73 79 6e 63 68 61 73 68 run-id (synchash
1ae0: 3a 63 6c 69 65 6e 74 2d 67 65 74 20 27 64 62 3a :client-get 'db:
1af0: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
1b00: 6e 2d 6d 69 6e 64 61 74 61 20 67 65 74 2d 74 65 n-mindata get-te
1b10: 73 74 73 2d 73 69 67 20 30 20 64 61 74 61 20 72 sts-sig 0 data r
1b20: 75 6e 2d 69 64 20 31 20 74 65 73 74 70 61 74 74 un-id 1 testpatt
1b30: 20 73 74 61 74 65 73 20 73 74 61 74 75 73 65 73 states statuses
1b40: 20 23 66 29 29 29 29 0a 3b 3b 20 09 09 09 09 20 #f)))).;; ....
1b50: 20 20 20 20 20 20 72 75 6e 2d 69 64 73 29 0a 3b run-ids).;
1b60: 3b 20 09 09 09 20 20 20 20 20 72 65 73 29 29 0a ; ... res)).
1b70: 3b 3b 20 09 20 28 72 75 6e 73 2d 68 61 73 68 20 ;; . (runs-hash
1b80: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
1b90: 65 66 2f 64 65 66 61 75 6c 74 20 64 61 74 61 20 ef/default data
1ba0: 67 65 74 2d 72 75 6e 73 2d 73 69 67 20 23 66 29 get-runs-sig #f)
1bb0: 29 0a 3b 3b 20 09 20 28 68 65 61 64 65 72 20 20 ).;; . (header
1bc0: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
1bd0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 75 6e -ref/default run
1be0: 73 2d 68 61 73 68 20 22 68 65 61 64 65 72 22 20 s-hash "header"
1bf0: 23 66 29 29 0a 3b 3b 20 09 20 28 72 75 6e 2d 69 #f)).;; . (run-i
1c00: 64 73 20 20 20 20 20 20 28 73 6f 72 74 20 28 66 ds (sort (f
1c10: 69 6c 74 65 72 20 6e 75 6d 62 65 72 3f 20 28 68 ilter number? (h
1c20: 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 ash-table-keys r
1c30: 75 6e 73 2d 68 61 73 68 29 29 0a 3b 3b 20 09 09 uns-hash)).;; ..
1c40: 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 . (lambda (a
1c50: 20 62 29 0a 3b 3b 20 09 09 09 20 20 20 20 20 20 b).;; ...
1c60: 20 28 6c 65 74 2a 20 28 28 72 65 63 6f 72 64 2d (let* ((record-
1c70: 61 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 a (hash-table-re
1c80: 66 20 72 75 6e 73 2d 68 61 73 68 20 61 29 29 0a f runs-hash a)).
1c90: 3b 3b 20 09 09 09 09 20 20 20 20 20 20 28 72 65 ;; .... (re
1ca0: 63 6f 72 64 2d 62 20 28 68 61 73 68 2d 74 61 62 cord-b (hash-tab
1cb0: 6c 65 2d 72 65 66 20 72 75 6e 73 2d 68 61 73 68 le-ref runs-hash
1cc0: 20 62 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 b)).;; ....
1cd0: 20 20 28 74 69 6d 65 2d 61 20 20 20 28 64 62 3a (time-a (db:
1ce0: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
1cf0: 64 65 72 20 72 65 63 6f 72 64 2d 61 20 68 65 61 der record-a hea
1d00: 64 65 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 der "event_time"
1d10: 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 20 )).;; ....
1d20: 28 74 69 6d 65 2d 62 20 20 20 28 64 62 3a 67 65 (time-b (db:ge
1d30: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
1d40: 72 20 72 65 63 6f 72 64 2d 62 20 68 65 61 64 65 r record-b heade
1d50: 72 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 29 r "event_time"))
1d60: 29 0a 3b 3b 20 09 09 09 09 20 28 3e 20 74 69 6d ).;; .... (> tim
1d70: 65 2d 61 20 74 69 6d 65 2d 62 29 29 29 0a 3b 3b e-a time-b))).;;
1d80: 20 09 09 09 20 20 20 20 20 29 29 0a 3b 3b 20 09 ... )).;; .
1d90: 20 28 72 75 6e 69 64 2d 74 6f 2d 63 6f 6c 20 20 (runid-to-col
1da0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
1db0: 66 20 2a 63 61 63 68 65 64 61 74 61 2a 20 22 72 f *cachedata* "r
1dc0: 75 6e 69 64 2d 74 6f 2d 63 6f 6c 22 29 29 0a 3b unid-to-col")).;
1dd0: 3b 20 09 20 28 74 65 73 74 6e 61 6d 65 2d 74 6f ; . (testname-to
1de0: 2d 72 6f 77 20 28 68 61 73 68 2d 74 61 62 6c 65 -row (hash-table
1df0: 2d 72 65 66 20 2a 63 61 63 68 65 64 61 74 61 2a -ref *cachedata*
1e00: 20 22 74 65 73 74 6e 61 6d 65 2d 74 6f 2d 72 6f "testname-to-ro
1e10: 77 22 29 29 20 0a 3b 3b 20 09 20 28 63 6f 6c 6e w")) .;; . (coln
1e20: 75 6d 20 20 20 20 20 20 20 31 29 0a 3b 3b 20 09 um 1).;; .
1e30: 20 28 72 6f 77 6e 75 6d 20 20 20 20 20 20 20 30 (rownum 0
1e40: 29 0a 3b 3b 20 09 20 28 63 65 6c 6c 6e 61 6d 65 ).;; . (cellname
1e50: 20 28 63 6f 6e 63 20 72 6f 77 6e 75 6d 20 22 3a (conc rownum ":
1e60: 22 20 63 6f 6c 6e 75 6d 29 29 29 20 3b 3b 20 72 " colnum))) ;; r
1e70: 6f 77 6e 75 6d 20 3d 20 30 20 69 73 20 74 68 65 ownum = 0 is the
1e80: 20 68 65 61 64 65 72 0a 3b 3b 20 3b 3b 20 28 64 header.;; ;; (d
1e90: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
1ea0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
1eb0: 22 74 65 73 74 2d 69 64 73 20 22 20 74 65 73 74 "test-ids " test
1ec0: 2d 69 64 73 20 22 2c 20 74 65 73 74 73 2d 64 65 -ids ", tests-de
1ed0: 74 61 69 6c 2d 63 68 61 6e 67 65 73 20 22 20 74 tail-changes " t
1ee0: 65 73 74 73 2d 64 65 74 61 69 6c 2d 63 68 61 6e ests-detail-chan
1ef0: 67 65 73 29 0a 3b 3b 20 20 20 20 20 0a 3b 3b 20 ges).;; .;;
1f00: 09 20 3b 3b 20 74 65 73 74 73 20 72 65 6c 61 74 . ;; tests relat
1f10: 65 64 20 73 74 75 66 66 0a 3b 3b 20 09 20 3b 3b ed stuff.;; . ;;
1f20: 20 28 61 6c 6c 2d 74 65 73 74 6e 61 6d 65 73 20 (all-testnames
1f30: 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 (delete-duplicat
1f40: 65 73 20 28 6d 61 70 20 64 62 3a 74 65 73 74 2d es (map db:test-
1f50: 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 get-testname tes
1f60: 74 2d 63 68 61 6e 67 65 73 29 29 29 29 0a 3b 3b t-changes)))).;;
1f70: 20 0a 3b 3b 20 20 20 20 20 3b 3b 20 47 69 76 65 .;; ;; Give
1f80: 6e 20 61 20 72 75 6e 2d 69 64 20 61 6e 64 20 74 n a run-id and t
1f90: 65 73 74 6e 61 6d 65 2f 69 74 65 6d 5f 70 61 74 estname/item_pat
1fa0: 68 20 63 61 6c 63 75 6c 61 74 65 20 61 20 63 65 h calculate a ce
1fb0: 6c 6c 20 52 3a 43 0a 3b 3b 20 0a 3b 3b 20 20 20 ll R:C.;; .;;
1fc0: 20 20 3b 3b 20 4e 4f 54 45 3a 20 41 6c 73 6f 20 ;; NOTE: Also
1fd0: 62 75 69 6c 64 20 74 68 65 20 74 65 73 74 20 74 build the test t
1fe0: 72 65 65 20 62 72 6f 77 73 65 72 20 61 6e 64 20 ree browser and
1ff0: 6c 6f 6f 6b 20 75 70 20 74 61 62 6c 65 0a 3b 3b look up table.;;
2000: 20 20 20 20 20 3b 3b 0a 3b 3b 20 20 20 20 20 3b ;;.;; ;
2010: 3b 20 45 61 63 68 20 72 75 6e 20 69 73 20 75 6e ; Each run is un
2020: 69 71 75 65 20 6f 6e 20 69 74 73 20 6b 65 79 73 ique on its keys
2030: 20 61 6e 64 20 72 75 6e 6e 61 6d 65 20 6f 72 20 and runname or
2040: 72 75 6e 2d 69 64 2c 20 73 74 6f 72 65 20 69 6e run-id, store in
2050: 20 68 61 73 68 20 6f 6e 20 63 6f 6c 6e 75 6d 0a hash on colnum.
2060: 3b 3b 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 ;; (for-each
2070: 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 (lambda (run-id
2080: 29 0a 3b 3b 20 09 09 28 6c 65 74 2a 20 28 28 72 ).;; ..(let* ((r
2090: 75 6e 2d 72 65 63 6f 72 64 20 28 68 61 73 68 2d un-record (hash-
20a0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
20b0: 74 20 72 75 6e 73 2d 68 61 73 68 20 72 75 6e 2d t runs-hash run-
20c0: 69 64 20 23 66 29 29 0a 3b 3b 20 09 09 20 20 20 id #f)).;; ..
20d0: 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 20 20 20 (key-vals
20e0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 (map (lambda (ke
20f0: 79 29 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d y)(db:get-value-
2100: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 2d 72 65 by-header run-re
2110: 63 6f 72 64 20 68 65 61 64 65 72 20 6b 65 79 29 cord header key)
2120: 29 0a 3b 3b 20 09 09 09 09 09 6b 65 79 73 29 29 ).;; .....keys))
2130: 0a 3b 3b 20 09 09 20 20 20 20 20 20 20 28 72 75 .;; .. (ru
2140: 6e 2d 6e 61 6d 65 20 20 20 28 64 62 3a 67 65 74 n-name (db:get
2150: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
2160: 20 72 75 6e 2d 72 65 63 6f 72 64 20 68 65 61 64 run-record head
2170: 65 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 3b er "runname")).;
2180: 3b 20 09 09 20 20 20 20 20 20 20 28 63 6f 6c 2d ; .. (col-
2190: 6e 61 6d 65 20 20 20 28 63 6f 6e 63 20 28 73 74 name (conc (st
21a0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
21b0: 20 6b 65 79 2d 76 61 6c 73 20 22 5c 6e 22 29 20 key-vals "\n")
21c0: 22 5c 6e 22 20 72 75 6e 2d 6e 61 6d 65 29 29 0a "\n" run-name)).
21d0: 3b 3b 20 09 09 20 20 20 20 20 20 20 28 72 75 6e ;; .. (run
21e0: 2d 70 61 74 68 20 20 20 28 61 70 70 65 6e 64 20 -path (append
21f0: 6b 65 79 2d 76 61 6c 73 20 28 6c 69 73 74 20 72 key-vals (list r
2200: 75 6e 2d 6e 61 6d 65 29 29 29 29 0a 3b 3b 20 09 un-name)))).;; .
2210: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 . (hash-table-s
2220: 65 74 21 20 28 64 62 6f 61 72 64 3a 74 61 62 64 et! (dboard:tabd
2230: 61 74 2d 72 75 6e 2d 6b 65 79 73 20 64 61 74 61 at-run-keys data
2240: 29 20 72 75 6e 2d 69 64 20 72 75 6e 2d 70 61 74 ) run-id run-pat
2250: 68 29 0a 3b 3b 20 09 09 20 20 3b 3b 20 6d 6f 64 h).;; .. ;; mod
2260: 69 66 79 20 63 65 6c 6c 20 2d 20 62 75 74 20 6f ify cell - but o
2270: 6e 6c 79 20 69 66 20 63 68 61 6e 67 65 64 0a 3b nly if changed.;
2280: 3b 20 09 09 20 20 28 73 65 74 21 20 63 68 61 6e ; .. (set! chan
2290: 67 65 64 20 28 64 63 6f 6d 6d 6f 6e 3a 6d 6f 64 ged (dcommon:mod
22a0: 69 66 69 79 2d 69 66 2d 64 69 66 66 65 72 65 6e ifiy-if-differen
22b0: 74 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 t (dboard:tabdat
22c0: 2d 72 75 6e 73 2d 6d 61 74 72 69 78 20 64 61 74 -runs-matrix dat
22d0: 61 29 20 63 65 6c 6c 6e 61 6d 65 20 63 6f 6c 2d a) cellname col-
22e0: 6e 61 6d 65 20 63 68 61 6e 67 65 64 29 29 0a 3b name changed)).;
22f0: 3b 20 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c ; .. (hash-tabl
2300: 65 2d 73 65 74 21 20 72 75 6e 69 64 2d 74 6f 2d e-set! runid-to-
2310: 63 6f 6c 20 72 75 6e 2d 69 64 20 28 6c 69 73 74 col run-id (list
2320: 20 63 6f 6c 6e 75 6d 20 72 75 6e 2d 72 65 63 6f colnum run-reco
2330: 72 64 29 29 0a 3b 3b 20 09 09 20 20 3b 3b 20 48 rd)).;; .. ;; H
2340: 65 72 65 20 77 65 20 75 70 64 61 74 65 20 74 68 ere we update th
2350: 65 20 74 65 73 74 73 20 74 72 65 65 62 6f 78 20 e tests treebox
2360: 61 6e 64 20 74 72 65 65 20 6b 65 79 73 0a 3b 3b and tree keys.;;
2370: 20 09 09 20 20 28 74 72 65 65 3a 61 64 64 2d 6e .. (tree:add-n
2380: 6f 64 65 20 28 64 62 6f 61 72 64 3a 74 61 62 64 ode (dboard:tabd
2390: 61 74 2d 74 65 73 74 73 2d 74 72 65 65 20 64 61 at-tests-tree da
23a0: 74 61 29 20 22 52 75 6e 73 22 20 28 61 70 70 65 ta) "Runs" (appe
23b0: 6e 64 20 6b 65 79 2d 76 61 6c 73 20 28 6c 69 73 nd key-vals (lis
23c0: 74 20 72 75 6e 2d 6e 61 6d 65 29 29 0a 3b 3b 20 t run-name)).;;
23d0: 09 09 09 09 20 75 73 65 72 64 61 74 61 3a 20 28 .... userdata: (
23e0: 63 6f 6e 63 20 22 72 75 6e 2d 69 64 3a 20 22 20 conc "run-id: "
23f0: 72 75 6e 2d 69 64 29 29 0a 3b 3b 20 09 09 20 20 run-id)).;; ..
2400: 28 73 65 74 21 20 63 6f 6c 6e 75 6d 20 28 2b 20 (set! colnum (+
2410: 63 6f 6c 6e 75 6d 20 31 29 29 29 29 0a 3b 3b 20 colnum 1)))).;;
2420: 09 20 20 20 20 20 20 72 75 6e 2d 69 64 73 29 0a . run-ids).
2430: 3b 3b 20 0a 3b 3b 20 20 20 20 20 3b 3b 20 53 63 ;; .;; ;; Sc
2440: 61 6e 20 61 6c 6c 20 74 65 73 74 73 20 74 6f 20 an all tests to
2450: 62 65 20 64 69 73 70 6c 61 79 65 64 20 61 6e 64 be displayed and
2460: 20 6f 72 67 61 6e 69 73 65 20 61 6c 6c 20 74 68 organise all th
2470: 65 20 74 65 73 74 20 6e 61 6d 65 73 2c 20 72 65 e test names, re
2480: 73 70 65 63 74 69 6e 67 20 77 68 61 74 20 69 73 specting what is
2490: 20 69 6e 20 74 68 65 20 68 61 73 68 20 74 61 62 in the hash tab
24a0: 6c 65 0a 3b 3b 20 20 20 20 20 3b 3b 20 44 6f 20 le.;; ;; Do
24b0: 74 68 69 73 20 61 6e 61 6c 79 73 69 73 20 69 6e this analysis in
24c0: 20 74 68 65 20 6f 72 64 65 72 20 6f 66 20 74 68 the order of th
24d0: 65 20 72 75 6e 2d 69 64 73 2c 20 74 68 65 20 6d e run-ids, the m
24e0: 6f 73 74 20 72 65 63 65 6e 74 20 72 75 6e 20 77 ost recent run w
24f0: 69 6e 73 0a 3b 3b 20 20 20 20 20 28 66 6f 72 2d ins.;; (for-
2500: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 72 75 each (lambda (ru
2510: 6e 2d 69 64 29 0a 3b 3b 20 09 09 28 6c 65 74 2a n-id).;; ..(let*
2520: 20 28 28 72 75 6e 2d 70 61 74 68 20 20 20 20 20 ((run-path
2530: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
2540: 66 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 f (dboard:tabdat
2550: 2d 72 75 6e 2d 6b 65 79 73 20 64 61 74 61 29 20 -run-keys data)
2560: 72 75 6e 2d 69 64 29 29 0a 3b 3b 20 09 09 20 20 run-id)).;; ..
2570: 20 20 20 20 20 28 74 65 73 74 2d 63 68 61 6e 67 (test-chang
2580: 65 73 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 es (hash-table
2590: 2d 72 65 66 20 61 6c 6c 2d 74 65 73 74 2d 63 68 -ref all-test-ch
25a0: 61 6e 67 65 73 20 72 75 6e 2d 69 64 29 29 0a 3b anges run-id)).;
25b0: 3b 20 09 09 20 20 20 20 20 20 20 28 6e 65 77 2d ; .. (new-
25c0: 74 65 73 74 2d 64 61 74 20 20 20 28 63 61 72 20 test-dat (car
25d0: 74 65 73 74 2d 63 68 61 6e 67 65 73 29 29 0a 3b test-changes)).;
25e0: 3b 20 09 09 20 20 20 20 20 20 20 28 72 65 6d 6f ; .. (remo
25f0: 76 65 64 2d 74 65 73 74 73 20 20 28 63 61 64 72 ved-tests (cadr
2600: 20 74 65 73 74 2d 63 68 61 6e 67 65 73 29 29 0a test-changes)).
2610: 3b 3b 20 09 09 20 20 20 20 20 20 20 28 74 65 73 ;; .. (tes
2620: 74 73 20 20 20 20 20 20 20 20 20 20 28 73 6f 72 ts (sor
2630: 74 20 28 6d 61 70 20 63 61 64 72 20 28 66 69 6c t (map cadr (fil
2640: 74 65 72 20 28 6c 61 6d 62 64 61 20 28 74 65 73 ter (lambda (tes
2650: 74 72 65 63 29 0a 3b 3b 20 09 09 09 09 09 09 09 trec).;; .......
2660: 09 20 28 65 71 3f 20 72 75 6e 2d 69 64 20 28 64 . (eq? run-id (d
2670: 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d 72 75 b:mintest-get-ru
2680: 6e 5f 69 64 20 28 63 61 64 72 20 74 65 73 74 72 n_id (cadr testr
2690: 65 63 29 29 29 29 0a 3b 3b 20 09 09 09 09 09 09 ec)))).;; ......
26a0: 09 20 20 20 20 20 20 20 6e 65 77 2d 74 65 73 74 . new-test
26b0: 2d 64 61 74 29 29 0a 3b 3b 20 09 09 09 09 09 20 -dat)).;; .....
26c0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 20 62 (lambda (a b
26d0: 29 0a 3b 3b 20 09 09 09 09 09 20 20 20 20 20 20 ).;; .....
26e0: 20 28 6c 65 74 20 28 28 74 69 6d 65 2d 61 20 28 (let ((time-a (
26f0: 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 2d 65 db:mintest-get-e
2700: 76 65 6e 74 5f 74 69 6d 65 20 61 29 29 0a 3b 3b vent_time a)).;;
2710: 20 09 09 09 09 09 09 20 20 20 20 20 28 74 69 6d ...... (tim
2720: 65 2d 62 20 28 64 62 3a 6d 69 6e 74 65 73 74 2d e-b (db:mintest-
2730: 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 62 get-event_time b
2740: 29 29 29 0a 3b 3b 20 09 09 09 09 09 09 20 28 3e ))).;; ...... (>
2750: 20 74 69 6d 65 2d 61 20 74 69 6d 65 2d 62 29 29 time-a time-b))
2760: 29 29 29 0a 3b 3b 20 09 09 20 20 20 20 20 20 20 ))).;; ..
2770: 3b 3b 20 74 65 73 74 2d 63 68 61 6e 67 65 73 20 ;; test-changes
2780: 69 73 20 61 20 6c 69 73 74 20 6f 66 20 28 28 20 is a list of ((
2790: 69 64 20 72 65 63 6f 72 64 20 29 20 2e 2e 2e 20 id record ) ...
27a0: 29 0a 3b 3b 20 09 09 20 20 20 20 20 20 20 3b 3b ).;; .. ;;
27b0: 20 47 65 74 20 6c 69 73 74 20 6f 66 20 74 65 73 Get list of tes
27c0: 74 20 6e 61 6d 65 73 20 73 6f 72 74 65 64 20 62 t names sorted b
27d0: 79 20 74 69 6d 65 2c 20 72 65 6d 6f 76 65 20 74 y time, remove t
27e0: 65 73 74 73 0a 3b 3b 20 09 09 20 20 20 20 20 20 ests.;; ..
27f0: 20 28 74 65 73 74 2d 6e 61 6d 65 73 20 28 64 65 (test-names (de
2800: 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 lete-duplicates
2810: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 74 29 (map (lambda (t)
2820: 0a 3b 3b 20 09 09 09 09 09 09 09 20 20 20 20 20 .;; .......
2830: 28 6c 65 74 20 28 28 69 20 28 64 62 3a 6d 69 6e (let ((i (db:min
2840: 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 5f 70 61 test-get-item_pa
2850: 74 68 20 74 29 29 0a 3b 3b 20 09 09 09 09 09 09 th t)).;; ......
2860: 09 09 20 20 20 28 6e 20 28 64 62 3a 6d 69 6e 74 .. (n (db:mint
2870: 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 est-get-testname
2880: 20 20 74 29 29 29 0a 3b 3b 20 09 09 09 09 09 09 t))).;; ......
2890: 09 20 20 20 20 20 20 20 28 69 66 20 28 73 74 72 . (if (str
28a0: 69 6e 67 3d 3f 20 69 20 22 22 29 0a 3b 3b 20 09 ing=? i "").;; .
28b0: 09 09 09 09 09 09 09 20 20 20 28 63 6f 6e 63 20 ....... (conc
28c0: 22 20 20 20 22 20 69 29 0a 3b 3b 20 09 09 09 09 " " i).;; ....
28d0: 09 09 09 09 20 20 20 6e 29 29 29 0a 3b 3b 20 09 .... n))).;; .
28e0: 09 09 09 09 09 09 20 20 20 74 65 73 74 73 29 29 ...... tests))
28f0: 29 0a 3b 3b 20 09 09 20 20 20 20 20 20 20 28 63 ).;; .. (c
2900: 6f 6c 6e 75 6d 20 20 20 20 20 28 63 61 72 20 28 olnum (car (
2910: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 72 hash-table-ref r
2920: 75 6e 69 64 2d 74 6f 2d 63 6f 6c 20 72 75 6e 2d unid-to-col run-
2930: 69 64 29 29 29 29 0a 3b 3b 20 09 09 20 20 3b 3b id)))).;; .. ;;
2940: 20 66 6f 72 20 65 61 63 68 20 74 65 73 74 20 6e for each test n
2950: 61 6d 65 20 67 65 74 20 74 68 65 20 73 6c 6f 74 ame get the slot
2960: 20 69 66 20 69 74 20 65 78 69 73 74 73 20 61 6e if it exists an
2970: 64 20 66 69 6c 6c 20 69 6e 20 74 68 65 20 63 65 d fill in the ce
2980: 6c 6c 0a 3b 3b 20 09 09 20 20 3b 3b 20 6f 72 20 ll.;; .. ;; or
2990: 74 61 6b 65 20 74 68 65 20 6e 65 78 74 20 73 6c take the next sl
29a0: 6f 74 20 61 6e 64 20 66 69 6c 6c 20 69 6e 20 74 ot and fill in t
29b0: 68 65 20 63 65 6c 6c 2c 20 64 65 61 6c 20 77 69 he cell, deal wi
29c0: 74 68 20 69 74 65 6d 73 20 69 6e 20 74 68 65 0a th items in the.
29d0: 3b 3b 20 09 09 20 20 3b 3b 20 72 75 6e 20 76 69 ;; .. ;; run vi
29e0: 65 77 20 70 61 6e 65 6c 3f 20 54 68 65 20 72 75 ew panel? The ru
29f0: 6e 20 76 69 65 77 20 70 61 6e 65 6c 20 63 61 6e n view panel can
2a00: 20 68 61 76 65 20 61 20 74 72 65 65 20 73 65 6c have a tree sel
2a10: 65 63 74 6f 72 20 66 6f 72 0a 3b 3b 20 09 09 20 ector for.;; ..
2a20: 20 3b 3b 20 62 72 6f 77 73 69 6e 67 20 74 68 65 ;; browsing the
2a30: 20 74 65 73 74 73 2f 69 74 65 6d 73 0a 3b 3b 20 tests/items.;;
2a40: 0a 3b 3b 20 09 09 20 20 3b 3b 20 53 57 49 54 43 .;; .. ;; SWITC
2a50: 48 20 54 48 49 53 20 54 4f 20 55 53 49 4e 47 20 H THIS TO USING
2a60: 43 48 41 4e 47 45 44 20 54 45 53 54 53 20 4f 4e CHANGED TESTS ON
2a70: 4c 59 0a 3b 3b 20 09 09 20 20 28 66 6f 72 2d 65 LY.;; .. (for-e
2a80: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 74 65 73 ach (lambda (tes
2a90: 74 29 0a 3b 3b 20 09 09 09 20 20 20 20 20 20 28 t).;; ... (
2aa0: 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 64 20 20 let* ((test-id
2ab0: 20 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 74 (db:mintest-get
2ac0: 2d 69 64 20 74 65 73 74 29 29 0a 3b 3b 20 09 09 -id test)).;; ..
2ad0: 09 09 20 20 20 20 20 28 73 74 61 74 65 20 20 20 .. (state
2ae0: 20 20 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 (db:mintest-ge
2af0: 74 2d 73 74 61 74 65 20 74 65 73 74 29 29 0a 3b t-state test)).;
2b00: 3b 20 09 09 09 09 20 20 20 20 20 28 73 74 61 74 ; .... (stat
2b10: 75 73 20 20 20 20 28 64 62 3a 6d 69 6e 74 65 73 us (db:mintes
2b20: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes
2b30: 74 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 t)).;; ....
2b40: 28 74 65 73 74 6e 61 6d 65 20 20 28 64 62 3a 6d (testname (db:m
2b50: 69 6e 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e intest-get-testn
2b60: 61 6d 65 20 74 65 73 74 29 29 0a 3b 3b 20 09 09 ame test)).;; ..
2b70: 09 09 20 20 20 20 20 28 69 74 65 6d 70 61 74 68 .. (itempath
2b80: 20 20 28 64 62 3a 6d 69 6e 74 65 73 74 2d 67 65 (db:mintest-ge
2b90: 74 2d 69 74 65 6d 5f 70 61 74 68 20 74 65 73 74 t-item_path test
2ba0: 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 28 )).;; .... (
2bb0: 66 75 6c 6c 6e 61 6d 65 20 20 28 63 6f 6e 63 20 fullname (conc
2bc0: 74 65 73 74 6e 61 6d 65 20 22 2f 22 20 69 74 65 testname "/" ite
2bd0: 6d 70 61 74 68 29 29 0a 3b 3b 20 09 09 09 09 20 mpath)).;; ....
2be0: 20 20 20 20 28 64 69 73 70 6e 61 6d 65 20 20 28 (dispname (
2bf0: 69 66 20 28 73 74 72 69 6e 67 3d 3f 20 69 74 65 if (string=? ite
2c00: 6d 70 61 74 68 20 22 22 29 20 74 65 73 74 6e 61 mpath "") testna
2c10: 6d 65 20 28 63 6f 6e 63 20 22 20 20 20 22 20 69 me (conc " " i
2c20: 74 65 6d 70 61 74 68 29 29 29 0a 3b 3b 20 09 09 tempath))).;; ..
2c30: 09 09 20 20 20 20 20 28 72 6f 77 6e 75 6d 20 20 .. (rownum
2c40: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
2c50: 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 6e 61 f/default testna
2c60: 6d 65 2d 74 6f 2d 72 6f 77 20 66 75 6c 6c 6e 61 me-to-row fullna
2c70: 6d 65 20 23 66 29 29 0a 3b 3b 20 09 09 09 09 20 me #f)).;; ....
2c80: 20 20 20 20 28 74 65 73 74 2d 70 61 74 68 20 28 (test-path (
2c90: 61 70 70 65 6e 64 20 72 75 6e 2d 70 61 74 68 20 append run-path
2ca0: 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d (if (equal? item
2cb0: 70 61 74 68 20 22 22 29 20 0a 3b 3b 20 09 09 09 path "") .;; ...
2cc0: 09 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 ..... (list
2cd0: 74 65 73 74 6e 61 6d 65 29 0a 3b 3b 20 09 09 09 testname).;; ...
2ce0: 09 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 ..... (list
2cf0: 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 70 61 74 testname itempat
2d00: 68 29 29 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 h)))).;; ....
2d10: 20 20 28 74 62 20 20 20 20 20 20 20 20 20 28 64 (tb (d
2d20: 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 74 65 73 board:tabdat-tes
2d30: 74 73 2d 74 72 65 65 20 64 61 74 61 29 29 29 0a ts-tree data))).
2d40: 3b 3b 20 09 09 09 09 28 70 72 69 6e 74 20 22 49 ;; ....(print "I
2d50: 4e 46 4f 4e 4f 54 45 3a 20 72 75 6e 2d 70 61 74 NFONOTE: run-pat
2d60: 68 3a 20 22 20 72 75 6e 2d 70 61 74 68 29 0a 3b h: " run-path).;
2d70: 3b 20 09 09 09 09 28 74 72 65 65 3a 61 64 64 2d ; ....(tree:add-
2d80: 6e 6f 64 65 20 28 64 62 6f 61 72 64 3a 74 61 62 node (dboard:tab
2d90: 64 61 74 2d 74 65 73 74 73 2d 74 72 65 65 20 64 dat-tests-tree d
2da0: 61 74 61 29 20 22 52 75 6e 73 22 20 0a 3b 3b 20 ata) "Runs" .;;
2db0: 09 09 09 09 09 20 20 20 20 20 20 20 74 65 73 74 ..... test
2dc0: 2d 70 61 74 68 0a 3b 3b 20 09 09 09 09 09 20 20 -path.;; .....
2dd0: 20 20 20 20 20 75 73 65 72 64 61 74 61 3a 20 28 userdata: (
2de0: 63 6f 6e 63 20 22 74 65 73 74 2d 69 64 3a 20 22 conc "test-id: "
2df0: 20 74 65 73 74 2d 69 64 29 29 0a 3b 3b 20 09 09 test-id)).;; ..
2e00: 09 09 28 6c 65 74 20 28 28 6e 6f 64 65 2d 6e 75 ..(let ((node-nu
2e10: 6d 20 28 74 72 65 65 3a 66 69 6e 64 2d 6e 6f 64 m (tree:find-nod
2e20: 65 20 74 62 20 28 63 6f 6e 73 20 22 52 75 6e 73 e tb (cons "Runs
2e30: 22 20 74 65 73 74 2d 70 61 74 68 29 29 29 0a 3b " test-path))).;
2e40: 3b 20 09 09 09 09 20 20 20 20 20 20 28 63 6f 6c ; .... (col
2e50: 6f 72 20 20 20 20 28 63 61 72 20 28 67 75 74 69 or (car (guti
2e60: 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 ls:get-color-for
2e70: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 73 74 -state-status st
2e80: 61 74 65 20 73 74 61 74 75 73 29 29 29 29 0a 3b ate status)))).;
2e90: 3b 20 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 ; .... (debug:p
2ea0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
2eb0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 6e 6f 64 65 2d log-port* "node-
2ec0: 6e 75 6d 3a 20 22 20 6e 6f 64 65 2d 6e 75 6d 20 num: " node-num
2ed0: 22 2c 20 63 6f 6c 6f 72 3a 20 22 20 63 6f 6c 6f ", color: " colo
2ee0: 72 29 0a 3b 3b 20 0a 3b 3b 20 09 09 09 09 20 20 r).;; .;; ....
2ef0: 28 73 65 74 21 20 63 68 61 6e 67 65 64 20 28 64 (set! changed (d
2f00: 63 6f 6d 6d 6f 6e 3a 6d 6f 64 69 66 69 79 2d 69 common:modifiy-i
2f10: 66 2d 64 69 66 66 65 72 65 6e 74 20 0a 3b 3b 20 f-different .;;
2f20: 09 09 09 09 09 09 20 74 62 0a 3b 3b 20 09 09 09 ...... tb.;; ...
2f30: 09 09 09 20 28 63 6f 6e 63 20 22 43 4f 4c 4f 52 ... (conc "COLOR
2f40: 22 20 6e 6f 64 65 2d 6e 75 6d 29 0a 3b 3b 20 09 " node-num).;; .
2f50: 09 09 09 09 09 20 63 6f 6c 6f 72 20 63 68 61 6e ..... color chan
2f60: 67 65 64 29 29 0a 3b 3b 20 0a 3b 3b 20 09 09 09 ged)).;; .;; ...
2f70: 09 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 . ;; (iup:attri
2f80: 62 75 74 65 2d 73 65 74 21 20 74 62 20 28 63 6f bute-set! tb (co
2f90: 6e 63 20 22 43 4f 4c 4f 52 22 20 6e 6f 64 65 2d nc "COLOR" node-
2fa0: 6e 75 6d 29 20 63 6f 6c 6f 72 29 0a 3b 3b 20 09 num) color).;; .
2fb0: 09 09 09 20 20 29 0a 3b 3b 20 09 09 09 09 28 68 ... ).;; ....(h
2fc0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 28 ash-table-set! (
2fd0: 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 70 61 dboard:tabdat-pa
2fe0: 74 68 2d 74 65 73 74 2d 69 64 73 20 64 61 74 61 th-test-ids data
2ff0: 29 20 74 65 73 74 2d 70 61 74 68 20 74 65 73 74 ) test-path test
3000: 2d 69 64 29 0a 3b 3b 20 09 09 09 09 28 69 66 20 -id).;; ....(if
3010: 28 6e 6f 74 20 72 6f 77 6e 75 6d 29 0a 3b 3b 20 (not rownum).;;
3020: 09 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 72 .... (let ((r
3030: 6f 77 6e 75 6d 73 20 28 68 61 73 68 2d 74 61 62 ownums (hash-tab
3040: 6c 65 2d 76 61 6c 75 65 73 20 74 65 73 74 6e 61 le-values testna
3050: 6d 65 2d 74 6f 2d 72 6f 77 29 29 29 0a 3b 3b 20 me-to-row))).;;
3060: 09 09 09 09 20 20 20 20 20 20 28 73 65 74 21 20 .... (set!
3070: 72 6f 77 6e 75 6d 20 28 69 66 20 28 6e 75 6c 6c rownum (if (null
3080: 3f 20 72 6f 77 6e 75 6d 73 29 0a 3b 3b 20 09 09 ? rownums).;; ..
3090: 09 09 09 09 20 20 20 20 20 20 20 31 0a 3b 3b 20 .... 1.;;
30a0: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 2b 20 ...... (+
30b0: 31 20 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 20 72 6f 1 (common:max ro
30c0: 77 6e 75 6d 73 29 29 29 29 0a 3b 3b 20 09 09 09 wnums)))).;; ...
30d0: 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 . (hash-tab
30e0: 6c 65 2d 73 65 74 21 20 74 65 73 74 6e 61 6d 65 le-set! testname
30f0: 2d 74 6f 2d 72 6f 77 20 66 75 6c 6c 6e 61 6d 65 -to-row fullname
3100: 20 72 6f 77 6e 75 6d 29 0a 3b 3b 20 09 09 09 09 rownum).;; ....
3110: 20 20 20 20 20 20 3b 3b 20 63 72 65 61 74 65 20 ;; create
3120: 74 68 65 20 6c 61 62 65 6c 0a 3b 3b 20 09 09 09 the label.;; ...
3130: 09 20 20 20 20 20 20 28 73 65 74 21 20 63 68 61 . (set! cha
3140: 6e 67 65 64 20 28 64 63 6f 6d 6d 6f 6e 3a 6d 6f nged (dcommon:mo
3150: 64 69 66 69 79 2d 69 66 2d 64 69 66 66 65 72 65 difiy-if-differe
3160: 6e 74 20 0a 3b 3b 20 09 09 09 09 09 09 20 20 20 nt .;; ......
3170: 20 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 (dboard:tabdat
3180: 2d 72 75 6e 73 2d 6d 61 74 72 69 78 20 64 61 74 -runs-matrix dat
3190: 61 29 0a 3b 3b 20 09 09 09 09 09 09 20 20 20 20 a).;; ......
31a0: 20 28 63 6f 6e 63 20 72 6f 77 6e 75 6d 20 22 3a (conc rownum ":
31b0: 22 20 30 29 0a 3b 3b 20 09 09 09 09 09 09 20 20 " 0).;; ......
31c0: 20 20 20 64 69 73 70 6e 61 6d 65 0a 3b 3b 20 09 dispname.;; .
31d0: 09 09 09 09 09 20 20 20 20 20 63 68 61 6e 67 65 ..... change
31e0: 64 29 29 0a 3b 3b 20 09 09 09 09 20 20 20 20 20 d)).;; ....
31f0: 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 ;; (iup:attribu
3200: 74 65 2d 73 65 74 21 20 28 64 62 6f 61 72 64 3a te-set! (dboard:
3210: 74 61 62 64 61 74 2d 72 75 6e 73 2d 6d 61 74 72 tabdat-runs-matr
3220: 69 78 20 64 61 74 61 29 0a 3b 3b 20 09 09 09 09 ix data).;; ....
3230: 20 20 20 20 20 20 3b 3b 20 20 20 09 09 20 20 28 ;; .. (
3240: 63 6f 6e 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20 conc rownum ":"
3250: 30 29 20 64 69 73 70 6e 61 6d 65 29 0a 3b 3b 20 0) dispname).;;
3260: 09 09 09 09 20 20 20 20 20 20 29 29 0a 3b 3b 20 .... )).;;
3270: 09 09 09 09 3b 3b 20 73 65 74 20 74 68 65 20 63 ....;; set the c
3280: 65 6c 6c 20 74 65 78 74 20 61 6e 64 20 63 6f 6c ell text and col
3290: 6f 72 0a 3b 3b 20 09 09 09 09 3b 3b 20 28 64 65 or.;; ....;; (de
32a0: 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 bug:print 2 *def
32b0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
32c0: 72 6f 77 6e 75 6d 3a 63 6f 6c 6e 75 6d 3d 22 20 rownum:colnum="
32d0: 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 rownum ":" colnu
32e0: 6d 20 22 2c 20 73 74 61 74 65 3d 22 20 73 74 61 m ", state=" sta
32f0: 74 75 73 29 0a 3b 3b 20 09 09 09 09 28 73 65 74 tus).;; ....(set
3300: 21 20 63 68 61 6e 67 65 64 20 28 64 63 6f 6d 6d ! changed (dcomm
3310: 6f 6e 3a 6d 6f 64 69 66 69 79 2d 69 66 2d 64 69 on:modifiy-if-di
3320: 66 66 65 72 65 6e 74 20 0a 3b 3b 20 09 09 09 09 fferent .;; ....
3330: 09 09 20 20 20 20 20 28 64 62 6f 61 72 64 3a 74 .. (dboard:t
3340: 61 62 64 61 74 2d 72 75 6e 73 2d 6d 61 74 72 69 abdat-runs-matri
3350: 78 20 64 61 74 61 29 0a 3b 3b 20 09 09 09 09 09 x data).;; .....
3360: 09 20 20 20 20 20 28 63 6f 6e 63 20 72 6f 77 6e . (conc rown
3370: 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 0a 3b um ":" colnum).;
3380: 3b 20 09 09 09 09 09 09 20 20 20 20 20 28 69 66 ; ...... (if
3390: 20 28 6d 65 6d 62 65 72 20 73 74 61 74 65 20 27 (member state '
33a0: 28 22 41 52 43 48 49 56 45 44 22 20 22 43 4f 4d ("ARCHIVED" "COM
33b0: 50 4c 45 54 45 44 22 29 29 0a 3b 3b 20 09 09 09 PLETED")).;; ...
33c0: 09 09 09 09 20 73 74 61 74 75 73 0a 3b 3b 20 09 .... status.;; .
33d0: 09 09 09 09 09 09 20 73 74 61 74 65 29 0a 3b 3b ...... state).;;
33e0: 20 09 09 09 09 09 09 20 20 20 20 20 63 68 61 6e ...... chan
33f0: 67 65 64 29 29 0a 3b 3b 20 09 09 09 09 3b 3b 20 ged)).;; ....;;
3400: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
3410: 65 74 21 20 28 64 62 6f 61 72 64 3a 74 61 62 64 et! (dboard:tabd
3420: 61 74 2d 72 75 6e 73 2d 6d 61 74 72 69 78 20 64 at-runs-matrix d
3430: 61 74 61 29 0a 3b 3b 20 09 09 09 09 3b 3b 20 09 ata).;; ....;; .
3440: 09 20 20 20 20 28 63 6f 6e 63 20 72 6f 77 6e 75 . (conc rownu
3450: 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 0a 3b 3b m ":" colnum).;;
3460: 20 09 09 09 09 3b 3b 20 09 09 20 20 20 20 28 69 ....;; .. (i
3470: 66 20 28 6d 65 6d 62 65 72 20 73 74 61 74 65 20 f (member state
3480: 27 28 22 41 52 43 48 49 56 45 44 22 20 22 43 4f '("ARCHIVED" "CO
3490: 4d 50 4c 45 54 45 44 22 29 29 0a 3b 3b 20 09 09 MPLETED")).;; ..
34a0: 09 09 3b 3b 20 09 09 09 73 74 61 74 75 73 0a 3b ..;; ...status.;
34b0: 3b 20 09 09 09 09 3b 3b 20 09 09 09 73 74 61 74 ; ....;; ...stat
34c0: 65 29 29 0a 3b 3b 20 09 09 09 09 28 73 65 74 21 e)).;; ....(set!
34d0: 20 63 68 61 6e 67 65 64 20 28 64 63 6f 6d 6d 6f changed (dcommo
34e0: 6e 3a 6d 6f 64 69 66 69 79 2d 69 66 2d 64 69 66 n:modifiy-if-dif
34f0: 66 65 72 65 6e 74 20 0a 3b 3b 20 09 09 09 09 09 ferent .;; .....
3500: 20 20 20 20 20 20 20 28 64 62 6f 61 72 64 3a 74 (dboard:t
3510: 61 62 64 61 74 2d 72 75 6e 73 2d 6d 61 74 72 69 abdat-runs-matri
3520: 78 20 64 61 74 61 29 0a 3b 3b 20 09 09 09 09 09 x data).;; .....
3530: 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 42 47 (conc "BG
3540: 43 4f 4c 4f 52 22 20 72 6f 77 6e 75 6d 20 22 3a COLOR" rownum ":
3550: 22 20 63 6f 6c 6e 75 6d 29 0a 3b 3b 20 09 09 09 " colnum).;; ...
3560: 09 09 20 20 20 20 20 20 20 28 63 61 72 20 28 67 .. (car (g
3570: 75 74 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d utils:get-color-
3580: 66 6f 72 2d 73 74 61 74 65 2d 73 74 61 74 75 73 for-state-status
3590: 20 73 74 61 74 65 20 73 74 61 74 75 73 29 29 0a state status)).
35a0: 3b 3b 20 09 09 09 09 09 20 20 20 20 20 20 20 63 ;; ..... c
35b0: 68 61 6e 67 65 64 29 29 0a 3b 3b 20 09 09 09 09 hanged)).;; ....
35c0: 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 ;; (iup:attribut
35d0: 65 2d 73 65 74 21 20 28 64 62 6f 61 72 64 3a 74 e-set! (dboard:t
35e0: 61 62 64 61 74 2d 72 75 6e 73 2d 6d 61 74 72 69 abdat-runs-matri
35f0: 78 20 64 61 74 61 29 0a 3b 3b 20 09 09 09 09 3b x data).;; ....;
3600: 3b 20 09 09 20 20 20 20 28 63 6f 6e 63 20 22 42 ; .. (conc "B
3610: 47 43 4f 4c 4f 52 22 20 72 6f 77 6e 75 6d 20 22 GCOLOR" rownum "
3620: 3a 22 20 63 6f 6c 6e 75 6d 29 0a 3b 3b 20 09 09 :" colnum).;; ..
3630: 09 09 3b 3b 20 09 09 20 20 20 20 28 63 61 72 20 ..;; .. (car
3640: 28 67 75 74 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f (gutils:get-colo
3650: 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 61 74 r-for-state-stat
3660: 75 73 20 73 74 61 74 65 20 73 74 61 74 75 73 29 us state status)
3670: 29 29 0a 3b 3b 20 09 09 09 09 29 29 0a 3b 3b 20 )).;; ....)).;;
3680: 09 09 09 20 20 20 20 74 65 73 74 73 29 29 29 0a ... tests))).
3690: 3b 3b 20 09 20 20 20 20 20 20 72 75 6e 2d 69 64 ;; . run-id
36a0: 73 29 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 28 6c s).;; .;; (l
36b0: 65 74 20 28 28 75 70 64 61 74 65 72 20 28 68 61 et ((updater (ha
36c0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
36d0: 61 75 6c 74 20 20 28 64 62 6f 61 72 64 3a 63 6f ault (dboard:co
36e0: 6d 6d 6f 6e 64 61 74 2d 75 70 64 61 74 65 72 73 mmondat-updaters
36f0: 20 63 6f 6d 6d 6f 6e 64 61 74 29 20 77 69 6e 64 commondat) wind
3700: 6f 77 2d 69 64 20 23 66 29 29 29 0a 3b 3b 20 20 ow-id #f))).;;
3710: 20 20 20 20 20 28 69 66 20 75 70 64 61 74 65 72 (if updater
3720: 20 28 75 70 64 61 74 65 72 20 28 68 61 73 68 2d (updater (hash-
3730: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
3740: 74 20 64 61 74 61 20 67 65 74 2d 64 65 74 61 69 t data get-detai
3750: 6c 73 2d 73 69 67 20 23 66 29 29 29 29 0a 3b 3b ls-sig #f)))).;;
3760: 20 0a 3b 3b 20 20 20 20 20 28 69 66 20 63 68 61 .;; (if cha
3770: 6e 67 65 64 20 28 69 75 70 3a 61 74 74 72 69 62 nged (iup:attrib
3780: 75 74 65 2d 73 65 74 21 20 28 64 62 6f 61 72 64 ute-set! (dboard
3790: 3a 74 61 62 64 61 74 2d 72 75 6e 73 2d 6d 61 74 :tabdat-runs-mat
37a0: 72 69 78 20 64 61 74 61 29 20 22 52 45 44 52 41 rix data) "REDRA
37b0: 57 22 20 22 41 4c 4c 22 29 29 0a 3b 3b 20 20 20 W" "ALL")).;;
37c0: 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e ;; (debug:prin
37d0: 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 2 *default-log
37e0: 2d 70 6f 72 74 2a 20 22 72 75 6e 2d 63 68 61 6e -port* "run-chan
37f0: 67 65 73 3a 20 22 20 72 75 6e 2d 63 68 61 6e 67 ges: " run-chang
3800: 65 73 29 0a 3b 3b 20 20 20 20 20 3b 3b 20 28 64 es).;; ;; (d
3810: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 ebug:print 2 *de
3820: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3830: 22 74 65 73 74 2d 63 68 61 6e 67 65 73 3a 20 22 "test-changes: "
3840: 20 74 65 73 74 2d 63 68 61 6e 67 65 73 29 0a 3b test-changes).;
3850: 3b 20 20 20 20 20 28 6c 69 73 74 20 72 75 6e 2d ; (list run-
3860: 63 68 61 6e 67 65 73 20 61 6c 6c 2d 74 65 73 74 changes all-test
3870: 2d 63 68 61 6e 67 65 73 29 29 29 0a 0a 23 3b 28 -changes)))..#;(
3880: 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a define (dcommon:
3890: 72 75 6e 73 64 61 74 2d 67 65 74 2d 63 6f 6c 2d runsdat-get-col-
38a0: 6e 75 6d 20 64 61 74 20 74 61 72 67 65 74 20 72 num dat target r
38b0: 75 6e 6e 61 6d 65 20 66 6f 72 63 65 2d 73 65 74 unname force-set
38c0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 ). (let* ((runs
38d0: 2d 69 6e 64 65 78 20 28 64 62 6f 61 72 64 3a 72 -index (dboard:r
38e0: 75 6e 73 64 61 74 2d 72 75 6e 73 2d 69 6e 64 65 unsdat-runs-inde
38f0: 78 20 64 61 74 29 29 0a 09 20 28 63 6f 6c 2d 6e x dat)).. (col-n
3900: 61 6d 65 20 20 20 28 63 6f 6e 63 20 74 61 72 67 ame (conc targ
3910: 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 29 et "/" runname))
3920: 0a 09 20 28 72 65 73 20 20 20 20 20 20 20 20 28 .. (res (
3930: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
3940: 65 66 61 75 6c 74 20 72 75 6e 73 2d 69 6e 64 65 efault runs-inde
3950: 78 20 63 6f 6c 2d 6e 61 6d 65 20 23 66 29 29 29 x col-name #f)))
3960: 0a 20 20 20 20 28 69 66 20 72 65 73 0a 09 72 65 . (if res..re
3970: 73 0a 09 28 69 66 20 66 6f 72 63 65 2d 73 65 74 s..(if force-set
3980: 0a 09 20 20 20 20 28 6c 65 74 20 28 28 6d 61 78 .. (let ((max
3990: 2d 63 6f 6c 2d 6e 75 6d 20 28 2b 20 31 20 28 63 -col-num (+ 1 (c
39a0: 6f 6d 6d 6f 6e 3a 6d 61 78 20 28 63 6f 6e 73 2d ommon:max (cons-
39b0: 31 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 76 61 1 (hash-table-va
39c0: 6c 75 65 73 20 72 75 6e 73 2d 69 6e 64 65 78 29 lues runs-index)
39d0: 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 68 61 ))))).. (ha
39e0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 75 sh-table-set! ru
39f0: 6e 73 2d 69 6e 64 65 78 20 63 6f 6c 2d 6e 61 6d ns-index col-nam
3a00: 65 20 6d 61 78 2d 63 6f 6c 2d 6e 75 6d 29 0a 09 e max-col-num)..
3a10: 20 20 20 20 20 20 6d 61 78 2d 63 6f 6c 2d 6e 75 max-col-nu
3a20: 6d 29 29 29 29 29 0a 0a 23 3b 28 64 65 66 69 6e m)))))..#;(defin
3a30: 65 20 28 64 63 6f 6d 6d 6f 6e 3a 72 75 6e 73 64 e (dcommon:runsd
3a40: 61 74 2d 67 65 74 2d 72 6f 77 2d 6e 75 6d 20 64 at-get-row-num d
3a50: 61 74 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d at testname item
3a60: 70 61 74 68 20 66 6f 72 63 65 2d 73 65 74 29 0a path force-set).
3a70: 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 73 2d (let* ((tests-
3a80: 69 6e 64 65 78 20 28 64 62 6f 61 72 64 3a 72 75 index (dboard:ru
3a90: 6e 73 64 61 74 2d 72 75 6e 73 2d 69 6e 64 65 78 nsdat-runs-index
3aa0: 20 64 61 74 29 29 0a 09 20 28 72 6f 77 2d 6e 61 dat)).. (row-na
3ab0: 6d 65 20 20 20 20 28 63 6f 6e 63 20 74 65 73 74 me (conc test
3ac0: 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d 70 61 74 name "/" itempat
3ad0: 68 29 29 0a 09 20 28 72 65 73 20 20 20 20 20 20 h)).. (res
3ae0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
3af0: 65 66 2f 64 65 66 61 75 6c 74 20 72 75 6e 73 2d ef/default runs-
3b00: 69 6e 64 65 78 20 72 6f 77 2d 6e 61 6d 65 20 23 index row-name #
3b10: 66 29 29 29 0a 20 20 20 20 28 69 66 20 72 65 73 f))). (if res
3b20: 0a 09 72 65 73 0a 09 28 69 66 20 66 6f 72 63 65 ..res..(if force
3b30: 2d 73 65 74 0a 09 20 20 20 20 28 6c 65 74 20 28 -set.. (let (
3b40: 28 6d 61 78 2d 72 6f 77 2d 6e 75 6d 20 28 2b 20 (max-row-num (+
3b50: 31 20 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 20 28 63 1 (common:max (c
3b60: 6f 6e 73 20 2d 31 20 28 68 61 73 68 2d 74 61 62 ons -1 (hash-tab
3b70: 6c 65 2d 76 61 6c 75 65 73 20 74 65 73 74 73 2d le-values tests-
3b80: 69 6e 64 65 78 29 29 29 29 29 29 0a 09 20 20 20 index))))))..
3b90: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
3ba0: 65 74 21 20 72 75 6e 73 2d 69 6e 64 65 78 20 72 et! runs-index r
3bb0: 6f 77 2d 6e 61 6d 65 20 6d 61 78 2d 72 6f 77 2d ow-name max-row-
3bc0: 6e 75 6d 29 0a 09 20 20 20 20 20 20 6d 61 78 2d num).. max-
3bd0: 72 6f 77 2d 6e 75 6d 29 29 29 29 29 0a 0a 28 64 row-num)))))..(d
3be0: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 72 efine (dcommon:r
3bf0: 75 6e 64 61 74 2d 63 6f 70 79 2d 74 65 73 74 73 undat-copy-tests
3c00: 2d 74 6f 2d 62 79 2d 6e 61 6d 65 20 72 75 6e 64 -to-by-name rund
3c10: 61 74 29 0a 20 20 28 6c 65 74 20 28 28 73 72 63 at). (let ((src
3c20: 2d 68 74 20 28 64 62 6f 61 72 64 3a 72 75 6e 64 -ht (dboard:rund
3c30: 61 74 2d 74 65 73 74 73 20 72 75 6e 64 61 74 29 at-tests rundat)
3c40: 29 0a 09 28 74 72 67 2d 68 74 20 28 64 62 6f 61 )..(trg-ht (dboa
3c50: 72 64 3a 72 75 6e 64 61 74 2d 74 65 73 74 73 2d rd:rundat-tests-
3c60: 62 79 2d 6e 61 6d 65 20 72 75 6e 64 61 74 29 29 by-name rundat))
3c70: 29 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 ). (if (and (
3c80: 68 61 73 68 2d 74 61 62 6c 65 3f 20 73 72 63 2d hash-table? src-
3c90: 68 74 29 28 68 61 73 68 2d 74 61 62 6c 65 3f 20 ht)(hash-table?
3ca0: 74 72 67 2d 68 74 29 29 0a 09 28 62 65 67 69 6e trg-ht))..(begin
3cb0: 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d .. (hash-table-
3cc0: 63 6c 65 61 72 21 20 74 72 67 2d 68 74 29 0a 09 clear! trg-ht)..
3cd0: 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 (for-each..
3ce0: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 (lambda (testdat
3cf0: 29 0a 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 ).. (hash-ta
3d00: 62 6c 65 2d 73 65 74 21 20 74 72 67 2d 68 74 20 ble-set! trg-ht
3d10: 28 74 65 73 74 3a 74 65 73 74 2d 67 65 74 2d 66 (test:test-get-f
3d20: 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 61 74 29 ullname testdat)
3d30: 20 74 65 73 74 64 61 74 29 29 0a 09 20 20 20 28 testdat)).. (
3d40: 68 61 73 68 2d 74 61 62 6c 65 2d 76 61 6c 75 65 hash-table-value
3d50: 73 20 73 72 63 2d 68 74 29 29 29 0a 09 28 64 65 s src-ht)))..(de
3d60: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
3d70: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
3d80: 57 41 52 4e 49 4e 47 3a 20 73 72 63 2d 68 74 20 WARNING: src-ht
3d90: 22 20 73 72 63 2d 68 74 20 22 20 74 72 67 2d 68 " src-ht " trg-h
3da0: 74 20 22 20 74 72 67 2d 68 74 29 29 29 29 0a 20 t " trg-ht)))).
3db0: 20 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;===========
3dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3dd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3de0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3df0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 ===========.;; T
3e00: 45 53 54 53 20 44 41 54 41 0a 3b 3b 3d 3d 3d 3d ESTS DATA.;;====
3e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3e50: 3d 3d 0a 0a 3b 3b 20 50 72 6f 64 75 63 65 20 61 ==..;; Produce a
3e60: 20 6c 69 73 74 20 6f 66 20 6c 69 73 74 73 20 72 list of lists r
3e70: 65 61 64 79 20 66 6f 72 20 63 6f 6d 6d 6f 6e 3a eady for common:
3e80: 73 70 61 72 73 65 2d 6c 69 73 74 2d 67 65 6e 65 sparse-list-gene
3e90: 72 61 74 65 2d 69 6e 64 65 78 0a 3b 3b 0a 28 64 rate-index.;;.(d
3ea0: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 6d efine (dcommon:m
3eb0: 69 6e 69 6d 69 7a 65 2d 74 65 73 74 2d 64 61 74 inimize-test-dat
3ec0: 61 20 74 65 73 74 73 2d 64 61 74 29 0a 20 20 28 a tests-dat). (
3ed0: 69 66 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 2d if (null? tests-
3ee0: 64 61 74 29 20 0a 20 20 20 20 20 20 27 28 29 0a dat) . '().
3ef0: 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 (let loop
3f00: 28 28 68 65 64 20 28 63 61 72 20 74 65 73 74 73 ((hed (car tests
3f10: 2d 64 61 74 29 29 0a 09 09 20 28 74 61 6c 20 28 -dat))... (tal (
3f20: 63 64 72 20 74 65 73 74 73 2d 64 61 74 29 29 0a cdr tests-dat)).
3f30: 09 09 20 28 72 65 73 20 27 28 29 29 29 0a 09 28 .. (res '()))..(
3f40: 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 64 20 20 let* ((test-id
3f50: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 (db:test-get-i
3f60: 64 20 68 65 64 29 29 20 3b 3b 20 6c 6f 6f 6b 20 d hed)) ;; look
3f70: 61 74 20 74 68 65 20 74 65 73 74 73 2d 64 61 74 at the tests-dat
3f80: 20 73 70 65 63 20 66 6f 72 20 6c 6f 63 61 74 69 spec for locati
3f90: 6f 6e 73 0a 09 20 20 20 20 20 20 20 28 74 65 73 ons.. (tes
3fa0: 74 2d 6e 61 6d 65 20 20 28 64 62 3a 74 65 73 74 t-name (db:test
3fb0: 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 68 65 -get-testname he
3fc0: 64 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 d)).. (ite
3fd0: 6d 2d 70 61 74 68 20 20 28 64 62 3a 74 65 73 74 m-path (db:test
3fe0: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 68 -get-item-path h
3ff0: 65 64 29 29 0a 09 20 20 20 20 20 20 20 28 73 74 ed)).. (st
4000: 61 74 65 20 20 20 20 20 20 28 64 62 3a 74 65 73 ate (db:tes
4010: 74 2d 67 65 74 2d 73 74 61 74 65 20 68 65 64 29 t-get-state hed)
4020: 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 75 ).. (statu
4030: 73 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 s (db:test-g
4040: 65 74 2d 73 74 61 74 75 73 20 68 65 64 29 29 0a et-status hed)).
4050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4060: 65 76 65 6e 74 2d 74 69 6d 65 20 28 64 62 3a 74 event-time (db:t
4070: 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 est-get-event_ti
4080: 6d 65 20 68 65 64 29 29 0a 09 20 20 20 20 20 20 me hed))..
4090: 20 28 6e 65 77 69 74 65 6d 20 20 20 20 28 6c 69 (newitem (li
40a0: 73 74 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 st test-name ite
40b0: 6d 2d 70 61 74 68 20 28 6c 69 73 74 20 74 65 73 m-path (list tes
40c0: 74 2d 69 64 20 73 74 61 74 65 20 73 74 61 74 75 t-id state statu
40d0: 73 20 65 76 65 6e 74 2d 74 69 6d 65 29 29 29 29 s event-time))))
40e0: 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 .. (if (null? t
40f0: 61 6c 29 0a 09 20 20 20 20 20 20 28 72 65 76 65 al).. (reve
4100: 72 73 65 20 28 63 6f 6e 73 20 6e 65 77 69 74 65 rse (cons newite
4110: 6d 20 72 65 73 29 29 0a 09 20 20 20 20 20 20 28 m res)).. (
4120: 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 loop (car tal)(c
4130: 64 72 20 74 61 6c 29 28 63 6f 6e 73 20 6e 65 77 dr tal)(cons new
4140: 69 74 65 6d 20 72 65 73 29 29 29 29 29 29 29 0a item res))))))).
4150: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f .(define (dcommo
4160: 6e 3a 74 65 73 74 73 2d 6d 69 6e 64 61 74 2d 3e n:tests-mindat->
4170: 68 61 73 68 20 74 65 73 74 73 2d 6d 69 6e 64 61 hash tests-minda
4180: 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 73 t). (let* ((res
4190: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
41a0: 65 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 e))). (for-ea
41b0: 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ch. (lambda
41c0: 28 69 74 65 6d 29 0a 20 20 20 20 20 20 20 28 6c (item). (l
41d0: 65 74 2a 20 28 28 74 65 73 74 2d 6e 61 6d 65 2b et* ((test-name+
41e0: 69 74 65 6d 2d 70 61 74 68 20 28 63 6f 6e 73 20 item-path (cons
41f0: 28 6c 69 73 74 2d 72 65 66 20 69 74 65 6d 20 30 (list-ref item 0
4200: 29 20 28 6c 69 73 74 2d 72 65 66 20 69 74 65 6d ) (list-ref item
4210: 20 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 1))).
4220: 20 20 20 20 28 76 61 6c 75 65 20 28 6c 69 73 74 (value (list
4230: 2d 72 65 66 20 69 74 65 6d 20 32 29 29 29 0a 20 -ref item 2))).
4240: 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 (hash-ta
4250: 62 6c 65 2d 73 65 74 21 20 72 65 73 20 74 65 73 ble-set! res tes
4260: 74 2d 6e 61 6d 65 2b 69 74 65 6d 2d 70 61 74 68 t-name+item-path
4270: 20 76 61 6c 75 65 29 29 29 0a 20 20 20 20 20 74 value))). t
4280: 65 73 74 73 2d 6d 69 6e 64 61 74 29 0a 20 20 20 ests-mindat).
4290: 20 72 65 73 29 29 0a 0a 3b 3b 20 72 65 74 75 72 res))..;; retur
42a0: 6e 20 31 20 69 66 20 73 74 61 74 75 73 31 20 69 n 1 if status1 i
42b0: 73 20 62 65 74 74 65 72 0a 3b 3b 20 72 65 74 75 s better.;; retu
42c0: 72 6e 20 30 20 69 66 20 73 74 61 74 75 73 31 20 rn 0 if status1
42d0: 61 6e 64 20 32 20 61 72 65 20 65 71 75 61 6c 6c and 2 are equall
42e0: 79 20 67 6f 6f 64 0a 3b 3b 20 72 65 74 75 72 6e y good.;; return
42f0: 20 2d 31 20 69 66 20 73 74 61 74 75 73 32 20 69 -1 if status2 i
4300: 73 20 62 65 74 74 65 72 0a 28 64 65 66 69 6e 65 s better.(define
4310: 20 28 64 63 6f 6d 6d 6f 6e 3a 73 74 61 74 75 73 (dcommon:status
4320: 2d 63 6f 6d 70 61 72 65 33 20 73 74 61 74 75 73 -compare3 status
4330: 31 20 73 74 61 74 75 73 32 29 0a 20 20 28 6c 65 1 status2). (le
4340: 74 2a 0a 20 20 20 20 20 20 28 28 73 74 61 74 75 t*. ((statu
4350: 73 2d 67 6f 6f 64 6e 65 73 73 2d 72 61 6e 6b 69 s-goodness-ranki
4360: 6e 67 20 20 28 63 64 72 20 3b 3b 20 63 64 72 20 ng (cdr ;; cdr
4370: 74 6f 20 64 72 6f 70 20 66 69 72 73 74 20 69 74 to drop first it
4380: 65 6d 20 2d 2d 20 22 6e 2f 61 22 0a 20 20 20 20 em -- "n/a".
4390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
43b0: 70 70 65 6e 64 20 28 6d 61 70 20 63 61 64 72 20 ppend (map cadr
43c0: 2a 63 6f 6d 6d 6f 6e 3a 73 74 64 2d 73 74 61 74 *common:std-stat
43d0: 75 73 65 73 2a 29 0a 20 20 20 20 20 20 20 20 20 uses*).
43e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4400: 20 27 28 23 66 29 29 20 3b 3b 20 61 6c 67 6f 72 '(#f)) ;; algor
4410: 69 74 68 6d 20 72 65 71 75 72 65 73 20 6c 61 73 ithm requres las
4420: 74 20 69 74 65 6d 20 74 6f 20 62 65 20 23 66 0a t item to be #f.
4430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4450: 20 20 29 20 20 29 0a 20 20 20 20 20 20 20 28 6d ) ). (m
4460: 65 6d 31 20 28 6d 65 6d 62 65 72 20 73 74 61 74 em1 (member stat
4470: 75 73 31 20 73 74 61 74 75 73 2d 67 6f 6f 64 6e us1 status-goodn
4480: 65 73 73 2d 72 61 6e 6b 69 6e 67 29 29 0a 20 20 ess-ranking)).
4490: 20 20 20 20 20 28 6d 65 6d 32 20 28 6d 65 6d 62 (mem2 (memb
44a0: 65 72 20 73 74 61 74 75 73 32 20 73 74 61 74 75 er status2 statu
44b0: 73 2d 67 6f 6f 64 6e 65 73 73 2d 72 61 6e 6b 69 s-goodness-ranki
44c0: 6e 67 29 29 0a 20 20 20 20 20 20 20 29 0a 20 20 ng)). ).
44d0: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 61 (cond. ((a
44e0: 6e 64 20 28 6e 6f 74 20 6d 65 6d 31 29 20 28 6e nd (not mem1) (n
44f0: 6f 74 20 6d 65 6d 32 29 29 20 30 29 0a 20 20 20 ot mem2)) 0).
4500: 20 20 28 28 6e 6f 74 20 6d 65 6d 31 29 20 2d 31 ((not mem1) -1
4510: 29 0a 20 20 20 20 20 28 28 6e 6f 74 20 6d 65 6d ). ((not mem
4520: 32 29 20 31 29 0a 20 20 20 20 20 28 28 3d 20 28 2) 1). ((= (
4530: 6c 65 6e 67 74 68 20 6d 65 6d 31 29 20 28 6c 65 length mem1) (le
4540: 6e 67 74 68 20 6d 65 6d 32 29 29 20 30 29 0a 20 ngth mem2)) 0).
4550: 20 20 20 20 28 28 3e 20 28 6c 65 6e 67 74 68 20 ((> (length
4560: 6d 65 6d 31 29 20 28 6c 65 6e 67 74 68 20 6d 65 mem1) (length me
4570: 6d 32 29 29 20 31 29 0a 20 20 20 20 20 28 65 6c m2)) 1). (el
4580: 73 65 20 2d 31 29 29 29 29 0a 20 20 20 20 20 0a se -1)))). .
4590: 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e (define (dcommon
45a0: 3a 78 6f 72 2d 74 65 73 74 73 2d 6d 69 6e 64 61 :xor-tests-minda
45b0: 74 20 73 72 63 2d 74 65 73 74 73 2d 6d 69 6e 64 t src-tests-mind
45c0: 61 74 20 64 65 73 74 2d 74 65 73 74 73 2d 6d 69 at dest-tests-mi
45d0: 6e 64 61 74 20 23 21 6b 65 79 20 28 68 69 64 65 ndat #!key (hide
45e0: 2d 63 6c 65 61 6e 20 23 66 29 29 0a 20 20 28 6c -clean #f)). (l
45f0: 65 74 2a 20 28 28 73 72 63 2d 68 61 73 68 20 28 et* ((src-hash (
4600: 64 63 6f 6d 6d 6f 6e 3a 74 65 73 74 73 2d 6d 69 dcommon:tests-mi
4610: 6e 64 61 74 2d 3e 68 61 73 68 20 73 72 63 2d 74 ndat->hash src-t
4620: 65 73 74 73 2d 6d 69 6e 64 61 74 29 29 0a 20 20 ests-mindat)).
4630: 20 20 20 20 20 20 20 28 64 65 73 74 2d 68 61 73 (dest-has
4640: 68 20 28 64 63 6f 6d 6d 6f 6e 3a 74 65 73 74 73 h (dcommon:tests
4650: 2d 6d 69 6e 64 61 74 2d 3e 68 61 73 68 20 64 65 -mindat->hash de
4660: 73 74 2d 74 65 73 74 73 2d 6d 69 6e 64 61 74 29 st-tests-mindat)
4670: 29 0a 20 20 20 20 20 20 20 20 20 28 61 6c 6c 2d ). (all-
4680: 6b 65 79 73 0a 20 20 20 20 20 20 20 20 20 20 28 keys. (
4690: 72 65 76 65 72 73 65 20 28 73 6f 72 74 20 0a 20 reverse (sort .
46a0: 20 20 20 20 20 20 20 20 20 20 28 64 65 6c 65 74 (delet
46b0: 65 2d 64 75 70 6c 69 63 61 74 65 73 0a 20 20 20 e-duplicates.
46c0: 20 20 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 (append
46d0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 (hash-table-key
46e0: 73 20 73 72 63 2d 68 61 73 68 29 20 28 68 61 73 s src-hash) (has
46f0: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 64 65 73 h-table-keys des
4700: 74 2d 68 61 73 68 29 29 29 0a 0a 20 20 20 20 20 t-hash)))..
4710: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 (lambda (a
4720: 20 62 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 b) .
4730: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
4740: 20 20 20 20 20 20 28 28 3c 20 30 20 28 73 74 72 ((< 0 (str
4750: 69 6e 67 2d 63 6f 6d 70 61 72 65 33 20 28 63 61 ing-compare3 (ca
4760: 72 20 61 29 20 28 63 61 72 20 62 29 29 29 20 23 r a) (car b))) #
4770: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
4780: 20 28 28 3e 20 30 20 28 73 74 72 69 6e 67 2d 63 ((> 0 (string-c
4790: 6f 6d 70 61 72 65 33 20 28 63 61 72 20 61 29 20 ompare3 (car a)
47a0: 28 63 61 72 20 62 29 29 29 20 23 66 29 0a 20 20 (car b))) #f).
47b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 3c 20 ((<
47c0: 30 20 28 73 74 72 69 6e 67 2d 63 6f 6d 70 61 72 0 (string-compar
47d0: 65 33 20 28 63 64 72 20 61 29 20 28 63 64 72 20 e3 (cdr a) (cdr
47e0: 62 29 29 29 20 23 74 29 0a 20 20 20 20 20 20 20 b))) #t).
47f0: 20 20 20 20 20 20 20 28 65 6c 73 65 20 23 66 29 (else #f)
4800: 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 29 )).. )
4810: 29 29 29 0a 20 20 20 20 28 6c 65 74 20 28 28 72 ))). (let ((r
4820: 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 28 6d es. (m
4830: 61 70 20 3b 3b 20 54 4f 44 4f 3a 20 72 65 6e 61 ap ;; TODO: rena
4840: 6d 65 20 78 6f 72 20 74 6f 20 64 65 6c 74 61 20 me xor to delta
4850: 67 6c 6f 62 61 6c 6c 79 20 69 6e 20 64 63 6f 6d globally in dcom
4860: 6d 6f 6e 20 61 6e 64 20 64 61 73 68 62 6f 61 72 mon and dashboar
4870: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c d. (l
4880: 61 6d 62 64 61 20 28 6b 65 79 29 0a 20 20 20 20 ambda (key).
4890: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 (let*
48a0: 28 28 74 65 73 74 2d 6e 61 6d 65 20 28 63 61 72 ((test-name (car
48b0: 20 6b 65 79 29 29 0a 20 20 20 20 20 20 20 20 20 key)).
48c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 74 65 (ite
48d0: 6d 2d 70 61 74 68 20 28 63 64 72 20 6b 65 79 29 m-path (cdr key)
48e0: 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )..
48f0: 20 20 20 20 20 20 20 20 28 64 65 73 74 2d 76 61 (dest-va
4900: 6c 75 65 20 28 68 61 73 68 2d 74 61 62 6c 65 2d lue (hash-table-
4910: 72 65 66 2f 64 65 66 61 75 6c 74 20 64 65 73 74 ref/default dest
4920: 2d 68 61 73 68 20 6b 65 79 20 23 66 29 29 20 3b -hash key #f)) ;
4930: 3b 20 28 6c 69 73 74 20 74 65 73 74 2d 69 64 20 ; (list test-id
4940: 73 74 61 74 65 20 73 74 61 74 75 73 29 0a 20 20 state status).
4950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4960: 20 20 20 28 64 65 73 74 2d 74 65 73 74 2d 69 64 (dest-test-id
4970: 20 20 28 69 66 20 64 65 73 74 2d 76 61 6c 75 65 (if dest-value
4980: 20 28 6c 69 73 74 2d 72 65 66 20 64 65 73 74 2d (list-ref dest-
4990: 76 61 6c 75 65 20 30 29 20 23 66 29 29 0a 20 20 value 0) #f)).
49a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49b0: 20 20 20 28 64 65 73 74 2d 73 74 61 74 65 20 20 (dest-state
49c0: 20 20 28 69 66 20 64 65 73 74 2d 76 61 6c 75 65 (if dest-value
49d0: 20 28 6c 69 73 74 2d 72 65 66 20 64 65 73 74 2d (list-ref dest-
49e0: 76 61 6c 75 65 20 31 29 20 23 66 29 29 0a 20 20 value 1) #f)).
49f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a00: 20 20 20 28 64 65 73 74 2d 73 74 61 74 75 73 20 (dest-status
4a10: 20 20 28 69 66 20 64 65 73 74 2d 76 61 6c 75 65 (if dest-value
4a20: 20 28 6c 69 73 74 2d 72 65 66 20 64 65 73 74 2d (list-ref dest-
4a30: 76 61 6c 75 65 20 32 29 20 23 66 29 29 0a 0a 20 value 2) #f))..
4a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a50: 20 20 20 20 28 73 72 63 2d 76 61 6c 75 65 20 20 (src-value
4a60: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
4a70: 65 66 2f 64 65 66 61 75 6c 74 20 73 72 63 2d 68 ef/default src-h
4a80: 61 73 68 20 6b 65 79 20 23 66 29 29 20 20 20 3b ash key #f)) ;
4a90: 3b 20 28 6c 69 73 74 20 74 65 73 74 2d 69 64 20 ; (list test-id
4aa0: 73 74 61 74 65 20 73 74 61 74 75 73 29 0a 20 20 state status).
4ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ac0: 20 20 20 28 73 72 63 2d 74 65 73 74 2d 69 64 20 (src-test-id
4ad0: 20 20 28 69 66 20 73 72 63 2d 76 61 6c 75 65 20 (if src-value
4ae0: 28 6c 69 73 74 2d 72 65 66 20 73 72 63 2d 76 61 (list-ref src-va
4af0: 6c 75 65 20 30 29 20 23 66 29 29 0a 20 20 20 20 lue 0) #f)).
4b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b10: 20 28 73 72 63 2d 73 74 61 74 65 20 20 20 20 20 (src-state
4b20: 28 69 66 20 73 72 63 2d 76 61 6c 75 65 20 28 6c (if src-value (l
4b30: 69 73 74 2d 72 65 66 20 73 72 63 2d 76 61 6c 75 ist-ref src-valu
4b40: 65 20 31 29 20 23 66 29 29 0a 20 20 20 20 20 20 e 1) #f)).
4b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4b60: 73 72 63 2d 73 74 61 74 75 73 20 20 20 20 28 69 src-status (i
4b70: 66 20 73 72 63 2d 76 61 6c 75 65 20 28 6c 69 73 f src-value (lis
4b80: 74 2d 72 65 66 20 73 72 63 2d 76 61 6c 75 65 20 t-ref src-value
4b90: 32 29 20 23 66 29 29 0a 0a 20 20 20 20 20 20 20 2) #f))..
4ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
4bb0: 6e 63 6f 6d 70 6c 65 74 65 2d 73 74 61 74 75 73 ncomplete-status
4bc0: 65 73 20 27 28 22 44 45 4c 45 54 45 44 22 20 22 es '("DELETED" "
4bd0: 49 4e 43 4f 4d 50 4c 45 54 45 22 20 22 53 54 55 INCOMPLETE" "STU
4be0: 43 4b 2f 44 45 41 44 22 20 22 4e 2f 41 22 29 29 CK/DEAD" "N/A"))
4bf0: 20 3b 3b 20 69 66 20 61 6e 79 20 6f 66 20 74 68 ;; if any of th
4c00: 65 73 65 20 73 74 61 74 75 73 65 73 20 61 70 70 ese statuses app
4c10: 6c 79 2c 20 74 72 65 61 74 20 74 65 73 74 20 61 ly, treat test a
4c20: 73 20 69 6e 63 6f 6d 70 6c 65 74 65 0a 0a 20 20 s incomplete..
4c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c40: 20 20 20 28 64 65 73 74 2d 63 6f 6d 70 6c 65 74 (dest-complet
4c50: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
4c60: 20 20 20 20 20 20 20 20 28 61 6e 64 20 64 65 73 (and des
4c70: 74 2d 76 61 6c 75 65 20 64 65 73 74 2d 73 74 61 t-value dest-sta
4c80: 74 65 20 64 65 73 74 2d 73 74 61 74 75 73 0a 20 te dest-status.
4c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ca0: 20 20 20 20 20 20 20 20 20 20 28 65 71 75 61 6c (equal
4cb0: 3f 20 64 65 73 74 2d 73 74 61 74 65 20 22 43 4f ? dest-state "CO
4cc0: 4d 50 4c 45 54 45 44 22 29 0a 20 20 20 20 20 20 MPLETED").
4cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ce0: 20 20 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 (not (membe
4cf0: 72 20 64 65 73 74 2d 73 74 61 74 75 73 20 69 6e r dest-status in
4d00: 63 6f 6d 70 6c 65 74 65 2d 73 74 61 74 75 73 65 complete-statuse
4d10: 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 s)))).
4d20: 20 20 20 20 20 20 20 20 20 20 20 28 73 72 63 2d (src-
4d30: 63 6f 6d 70 6c 65 74 65 0a 20 20 20 20 20 20 20 complete.
4d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4d50: 61 6e 64 20 73 72 63 2d 76 61 6c 75 65 20 73 72 and src-value sr
4d60: 63 2d 73 74 61 74 65 20 73 72 63 2d 73 74 61 74 c-state src-stat
4d70: 75 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 us.
4d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
4d90: 71 75 61 6c 3f 20 73 72 63 2d 73 74 61 74 65 20 qual? src-state
4da0: 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 20 20 20 "COMPLETED").
4db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4dc0: 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 6d 65 (not (me
4dd0: 6d 62 65 72 20 73 72 63 2d 73 74 61 74 75 73 20 mber src-status
4de0: 69 6e 63 6f 6d 70 6c 65 74 65 2d 73 74 61 74 75 incomplete-statu
4df0: 73 65 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 ses)))).
4e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
4e10: 61 74 75 73 2d 63 6f 6d 70 61 72 65 2d 72 65 73 atus-compare-res
4e20: 75 6c 74 20 28 64 63 6f 6d 6d 6f 6e 3a 73 74 61 ult (dcommon:sta
4e30: 74 75 73 2d 63 6f 6d 70 61 72 65 33 20 73 72 63 tus-compare3 src
4e40: 2d 73 74 61 74 75 73 20 64 65 73 74 2d 73 74 61 -status dest-sta
4e50: 74 75 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 tus)).
4e60: 20 20 20 20 20 20 20 20 20 20 20 28 78 6f 72 2d (xor-
4e70: 6e 65 77 2d 69 74 65 6d 0a 20 20 20 20 20 20 20 new-item.
4e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4e90: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond.
4ea0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 63 ;; c
4eb0: 6f 6d 70 6c 65 74 65 2c 20 66 6f 72 20 74 68 69 omplete, for thi
4ec0: 73 20 63 61 73 65 20 6d 65 61 6e 73 3a 20 73 74 s case means: st
4ed0: 61 74 65 3d 63 6f 6d 70 65 6c 74 65 20 41 4e 44 ate=compelte AND
4ee0: 20 73 74 61 74 75 73 20 6e 6f 74 20 69 6e 20 28 status not in (
4ef0: 20 64 65 6c 65 74 65 64 20 75 6e 63 6f 6d 70 6c deleted uncompl
4f00: 65 74 65 20 73 74 75 63 6b 2f 64 65 61 64 20 6e ete stuck/dead n
4f10: 2f 61 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 /a ).
4f20: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 6e ;; n
4f30: 65 69 74 68 65 72 20 63 6f 6d 70 6c 65 74 65 20 either complete
4f40: 2d 3e 20 62 61 64 0a 0a 20 20 20 20 20 20 20 20 -> bad..
4f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
4f60: 3b 20 73 72 63 20 21 63 6f 6d 70 6c 65 74 65 2c ; src !complete,
4f70: 20 64 65 73 74 20 63 6f 6d 70 6c 65 74 65 20 2d dest complete -
4f80: 3e 20 62 65 74 74 65 72 0a 20 20 20 20 20 20 20 > better.
4f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4fa0: 28 28 61 6e 64 20 28 6e 6f 74 20 64 65 73 74 2d ((and (not dest-
4fb0: 63 6f 6d 70 6c 65 74 65 29 20 28 6e 6f 74 20 73 complete) (not s
4fc0: 72 63 2d 63 6f 6d 70 6c 65 74 65 29 29 0a 20 20 rc-complete)).
4fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4fe0: 20 20 20 20 20 20 28 6c 69 73 74 20 64 65 73 74 (list dest
4ff0: 2d 74 65 73 74 2d 69 64 20 22 42 4f 54 48 2d 42 -test-id "BOTH-B
5000: 41 44 22 20 22 42 4f 54 48 2d 49 4e 43 4f 4d 50 AD" "BOTH-INCOMP
5010: 4c 45 54 45 22 29 29 0a 20 20 20 20 20 20 20 20 LETE")).
5020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5030: 28 6e 6f 74 20 64 65 73 74 2d 63 6f 6d 70 6c 65 (not dest-comple
5040: 74 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 te).
5050: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 (lis
5060: 74 20 73 72 63 2d 74 65 73 74 2d 69 64 20 22 44 t src-test-id "D
5070: 49 46 46 2d 4d 49 53 53 49 4e 47 22 20 22 44 45 IFF-MISSING" "DE
5080: 53 54 2d 49 4e 43 4f 4d 50 4c 45 54 45 22 29 29 ST-INCOMPLETE"))
5090: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
50a0: 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f 74 20 ((not
50b0: 73 72 63 2d 63 6f 6d 70 6c 65 74 65 29 0a 20 20 src-complete).
50c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50d0: 20 20 20 20 20 20 28 6c 69 73 74 20 64 65 73 74 (list dest
50e0: 2d 74 65 73 74 2d 69 64 20 22 44 49 46 46 2d 4e -test-id "DIFF-N
50f0: 45 57 22 20 22 53 52 43 2d 49 4e 43 4f 4d 50 4c EW" "SRC-INCOMPL
5100: 45 54 45 22 29 29 20 20 20 20 20 20 0a 20 20 20 ETE")) .
5110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5120: 20 20 20 20 28 28 61 6e 64 0a 20 20 20 20 20 20 ((and.
5130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5140: 20 20 20 28 65 71 75 61 6c 3f 20 73 72 63 2d 73 (equal? src-s
5150: 74 61 74 65 20 64 65 73 74 2d 73 74 61 74 65 29 tate dest-state)
5160: 0a 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 28 65 71 75 61 6c (equal
5180: 3f 20 73 72 63 2d 73 74 61 74 75 73 20 64 65 73 ? src-status des
5190: 74 2d 73 74 61 74 75 73 29 29 0a 20 20 20 20 20 t-status)).
51a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51b0: 20 20 20 28 6c 69 73 74 20 64 65 73 74 2d 74 65 (list dest-te
51c0: 73 74 2d 69 64 20 20 28 63 6f 6e 63 20 22 43 4c st-id (conc "CL
51d0: 45 41 4e 22 29 20 28 63 6f 6e 63 20 22 43 4c 45 EAN") (conc "CLE
51e0: 41 4e 2d 22 20 64 65 73 74 2d 73 74 61 74 75 73 AN-" dest-status
51f0: 29 20 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 ) )) .
5200: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
5210: 20 20 20 62 65 74 74 65 72 20 6f 72 20 77 6f 72 better or wor
5220: 73 65 3a 20 70 61 73 73 20 3e 20 77 61 72 6e 20 se: pass > warn
5230: 3e 20 77 61 69 76 65 64 20 3e 20 73 6b 69 70 20 > waived > skip
5240: 3e 20 66 61 69 6c 20 3e 20 61 62 6f 72 74 0a 20 > fail > abort.
5250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5260: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 70 61 73 ;; pas
5270: 73 20 3e 20 77 61 72 6e 20 3e 20 77 61 69 76 65 s > warn > waive
5280: 64 20 3e 20 73 6b 69 70 20 3e 20 66 61 69 6c 20 d > skip > fail
5290: 3e 20 61 62 6f 72 74 0a 20 20 20 20 20 20 20 20 > abort.
52a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a .
52b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52c0: 20 20 20 20 20 20 20 28 28 3d 20 31 20 73 74 61 ((= 1 sta
52d0: 74 75 73 2d 63 6f 6d 70 61 72 65 2d 72 65 73 75 tus-compare-resu
52e0: 6c 74 29 20 3b 3b 20 73 72 63 20 69 73 20 62 65 lt) ;; src is be
52f0: 74 74 65 72 2c 20 64 65 73 74 20 69 73 20 77 6f tter, dest is wo
5300: 72 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 rse.
5310: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 (lis
5320: 74 20 64 65 73 74 2d 74 65 73 74 2d 69 64 20 22 t dest-test-id "
5330: 44 49 52 54 59 2d 57 4f 52 53 45 22 20 28 63 6f DIRTY-WORSE" (co
5340: 6e 63 20 73 72 63 2d 73 74 61 74 75 73 20 22 2d nc src-status "-
5350: 3e 22 20 64 65 73 74 2d 73 74 61 74 75 73 29 29 >" dest-status))
5360: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5370: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 (else.
5380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5390: 20 20 20 20 20 20 20 28 6c 69 73 74 20 64 65 73 (list des
53a0: 74 2d 74 65 73 74 2d 69 64 20 22 44 49 52 54 59 t-test-id "DIRTY
53b0: 2d 42 45 54 54 45 52 22 20 28 63 6f 6e 63 20 73 -BETTER" (conc s
53c0: 72 63 2d 73 74 61 74 75 73 20 22 2d 3e 22 20 64 rc-status "->" d
53d0: 65 73 74 2d 73 74 61 74 75 73 29 29 29 0a 20 20 est-status))).
53e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53f0: 20 20 20 20 20 29 29 29 0a 20 20 20 20 20 20 20 ))).
5400: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 74 (list t
5410: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
5420: 74 68 20 20 78 6f 72 2d 6e 65 77 2d 69 74 65 6d th xor-new-item
5430: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
5440: 61 6c 6c 2d 6b 65 79 73 29 29 29 0a 0a 20 20 20 all-keys)))..
5450: 20 20 20 28 69 66 20 68 69 64 65 2d 63 6c 65 61 (if hide-clea
5460: 6e 0a 20 20 20 20 20 20 20 20 20 20 28 66 69 6c n. (fil
5470: 74 65 72 0a 20 20 20 20 20 20 20 20 20 20 20 28 ter. (
5480: 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 20 20 lambda (item).
5490: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 28 70 72 ;;(pr
54a0: 69 6e 74 20 69 74 65 6d 29 0a 20 20 20 20 20 20 int item).
54b0: 20 20 20 20 20 20 20 28 6e 6f 74 0a 20 20 20 20 (not.
54c0: 20 20 20 20 20 20 20 20 20 20 28 65 71 75 61 6c (equal
54d0: 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ?.
54e0: 20 22 43 4c 45 41 4e 22 0a 20 20 20 20 20 20 20 "CLEAN".
54f0: 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d 72 65 (list-re
5500: 66 20 28 6c 69 73 74 2d 72 65 66 20 69 74 65 6d f (list-ref item
5510: 20 32 29 20 31 29 29 29 29 0a 20 20 20 20 20 20 2) 1)))).
5520: 20 20 20 20 20 72 65 73 29 0a 20 20 20 20 20 20 res).
5530: 20 20 20 20 72 65 73 29 29 29 29 0a 0a 28 64 65 res))))..(de
5540: 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 65 78 fine (dcommon:ex
5550: 61 6d 69 6e 65 2d 78 74 65 72 6d 20 72 75 6e 2d amine-xterm run-
5560: 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 6c id test-id). (l
5570: 65 74 2a 20 28 28 74 65 73 74 64 61 74 20 28 72 et* ((testdat (r
5580: 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f mt:get-test-info
5590: 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 -by-id run-id te
55a0: 73 74 2d 69 64 29 29 29 0a 20 20 20 20 28 69 66 st-id))). (if
55b0: 20 28 6e 6f 74 20 74 65 73 74 64 61 74 29 0a 20 (not testdat).
55c0: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 (begin.
55d0: 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 (debug:p
55e0: 72 69 6e 74 20 32 20 22 45 52 52 4f 52 3a 20 4e rint 2 "ERROR: N
55f0: 6f 20 74 65 73 74 20 64 61 74 61 20 66 6f 75 6e o test data foun
5600: 64 20 66 6f 72 20 74 65 73 74 20 22 20 74 65 73 d for test " tes
5610: 74 2d 69 64 20 22 2c 20 65 78 69 74 69 6e 67 22 t-id ", exiting"
5620: 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 78 69 ). (exi
5630: 74 20 31 29 29 0a 20 20 20 20 20 20 20 20 28 6c t 1)). (l
5640: 65 74 2a 0a 20 20 20 20 20 20 20 20 20 20 20 20 et*.
5650: 28 28 72 75 6e 64 69 72 20 20 20 20 20 20 20 20 ((rundir
5660: 28 69 66 20 74 65 73 74 64 61 74 20 0a 20 20 20 (if testdat .
5670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5680: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 (db
5690: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 :test-get-rundir
56a0: 20 74 65 73 74 64 61 74 29 0a 20 20 20 20 20 20 testdat).
56b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56c0: 20 20 20 20 20 20 20 20 20 20 28 63 75 72 72 65 (curre
56d0: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 29 20 nt-directory)))
56e0: 3b 3b 20 6c 6f 67 66 69 6c 65 29 29 0a 20 20 20 ;; logfile)).
56f0: 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74 66 (testf
5700: 75 6c 6c 6e 61 6d 65 20 20 28 69 66 20 74 65 73 ullname (if tes
5710: 74 64 61 74 20 28 64 62 3a 74 65 73 74 2d 67 65 tdat (db:test-ge
5720: 74 2d 66 75 6c 6c 6e 61 6d 65 20 74 65 73 74 64 t-fullname testd
5730: 61 74 29 20 22 47 61 74 68 65 72 69 6e 67 20 64 at) "Gathering d
5740: 61 74 61 20 2e 2e 2e 22 29 29 0a 20 20 20 20 20 ata ...")).
5750: 20 20 20 20 20 20 20 20 28 78 74 65 72 6d 20 20 (xterm
5760: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 (lambda ().
5770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5780: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 64 (if (d
5790: 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 3f irectory-exists?
57a0: 20 72 75 6e 64 69 72 29 0a 20 20 20 20 20 20 20 rundir).
57b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57c0: 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 (let* ((
57d0: 73 68 65 6c 6c 20 28 69 66 20 28 67 65 74 2d 65 shell (if (get-e
57e0: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
57f0: 62 6c 65 20 22 53 48 45 4c 4c 22 29 20 0a 20 20 ble "SHELL") .
5800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5830: 63 6f 6e 63 20 22 2d 65 20 22 20 28 67 65 74 2d conc "-e " (get-
5840: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
5850: 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 29 0a 20 able "SHELL")).
5860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5890: 22 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 "")).
58a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58b0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d (comm
58c0: 61 6e 64 20 28 63 6f 6e 63 20 22 63 64 20 22 20 and (conc "cd "
58d0: 72 75 6e 64 69 72 20 0a 20 20 20 20 20 20 20 20 rundir .
58e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5900: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 3b 6d ";m
5910: 74 5f 78 74 65 72 6d 20 2d 54 20 5c 22 22 20 28 t_xterm -T \"" (
5920: 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 string-translate
5930: 20 74 65 73 74 66 75 6c 6c 6e 61 6d 65 20 22 28 testfullname "(
5940: 29 22 20 22 20 20 22 29 20 22 5c 22 20 22 20 73 )" " ") "\" " s
5950: 68 65 6c 6c 20 22 26 22 29 29 29 0a 20 20 20 20 hell "&"))).
5960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5970: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 (pr
5980: 69 6e 74 20 22 43 6f 6d 6d 61 6e 64 20 3d 22 20 int "Command ="
5990: 63 6f 6d 6d 61 6e 64 29 0a 20 20 20 20 20 20 20 command).
59a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59b0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f (commo
59c0: 6e 3a 77 69 74 68 6f 75 74 2d 76 61 72 73 0a 20 n:without-vars.
59d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59f0: 20 63 6f 6d 6d 61 6e 64 0a 20 20 20 20 20 20 20 command.
5a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a10: 20 20 20 20 20 20 20 20 20 20 20 22 4d 54 5f 2e "MT_.
5a20: 2a 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 *")).
5a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a40: 20 20 20 20 28 6d 65 73 73 61 67 65 2d 77 69 6e (message-win
5a50: 64 6f 77 20 20 28 63 6f 6e 63 20 22 44 69 72 65 dow (conc "Dire
5a60: 63 74 6f 72 79 20 22 20 72 75 6e 64 69 72 20 22 ctory " rundir "
5a70: 20 6e 6f 74 20 66 6f 75 6e 64 22 29 29 29 29 29 not found")))))
5a80: 29 0a 20 20 20 20 20 20 20 20 20 20 28 78 74 65 ). (xte
5a90: 72 6d 29 0a 20 20 20 20 20 20 20 20 20 20 28 70 rm). (p
5aa0: 72 69 6e 74 20 22 41 64 64 69 6e 67 20 78 74 65 rint "Adding xte
5ab0: 72 6d 20 63 6f 64 65 22 29 29 29 29 29 0a 0a 3b rm code")))))..;
5ac0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b00: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 44 20 41 20 54 =======.;; D A T
5b10: 20 41 20 20 20 54 20 41 20 42 20 4c 20 45 20 53 A T A B L E S
5b20: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 54 61 =========..;; Ta
5b70: 62 6c 65 20 6f 66 20 6b 65 79 73 0a 28 64 65 66 ble of keys.(def
5b80: 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 6b 65 79 ine (dcommon:key
5b90: 73 2d 6d 61 74 72 69 78 20 72 61 77 63 6f 6e 66 s-matrix rawconf
5ba0: 69 67 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 75 ig). (let* ((cu
5bb0: 72 72 2d 72 6f 77 2d 6e 75 6d 20 31 29 0a 20 20 rr-row-num 1).
5bc0: 20 20 20 20 20 20 20 28 6b 65 79 2d 76 61 6c 73 (key-vals
5bd0: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 73 65 (configf:se
5be0: 63 74 69 6f 6e 2d 76 61 72 73 20 72 61 77 63 6f ction-vars rawco
5bf0: 6e 66 69 67 20 22 66 69 65 6c 64 73 22 29 29 0a nfig "fields")).
5c00: 20 20 20 20 20 20 20 20 20 28 6b 65 79 73 2d 6d (keys-m
5c10: 61 74 72 69 78 20 20 28 69 75 70 3a 6d 61 74 72 atrix (iup:matr
5c20: 69 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ix.
5c30: 20 20 20 20 20 20 20 20 20 20 20 23 3a 61 6c 69 #:ali
5c40: 67 6e 6d 65 6e 74 31 20 22 41 4c 45 46 54 22 0a gnment1 "ALEFT".
5c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c60: 20 20 20 20 20 20 20 20 23 3a 65 78 70 61 6e 64 #:expand
5c70: 20 22 59 45 53 22 20 3b 3b 20 22 48 4f 52 49 5a "YES" ;; "HORIZ
5c80: 4f 4e 54 41 4c 22 20 3b 3b 20 22 56 45 52 54 49 ONTAL" ;; "VERTI
5c90: 43 41 4c 22 0a 20 20 20 20 20 20 20 20 20 20 20 CAL".
5ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
5cb0: 23 3a 73 63 72 6f 6c 6c 62 61 72 20 22 59 45 53 #:scrollbar "YES
5cc0: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
5cd0: 20 20 20 20 20 20 20 20 20 20 23 3a 6e 75 6d 63 #:numc
5ce0: 6f 6c 20 31 0a 20 20 20 20 20 20 20 20 20 20 20 ol 1.
5cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 23 3a 6e #:n
5d00: 75 6d 6c 69 6e 20 28 6c 65 6e 67 74 68 20 6b 65 umlin (length ke
5d10: 79 2d 76 61 6c 73 29 0a 20 20 20 20 20 20 20 20 y-vals).
5d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d30: 23 3a 6e 75 6d 63 6f 6c 2d 76 69 73 69 62 6c 65 #:numcol-visible
5d40: 20 31 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 1.
5d50: 20 20 20 20 20 20 20 20 20 20 20 23 3a 6e 75 6d #:num
5d60: 6c 69 6e 2d 76 69 73 69 62 6c 65 20 28 6c 65 6e lin-visible (len
5d70: 67 74 68 20 6b 65 79 2d 76 61 6c 73 29 0a 20 20 gth key-vals).
5d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d90: 20 20 20 20 20 20 23 3a 63 6c 69 63 6b 2d 63 62 #:click-cb
5da0: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 6c 69 (lambda (obj li
5db0: 6e 20 63 6f 6c 20 73 74 61 74 75 73 29 0a 20 20 n col status).
5dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5de0: 20 20 20 28 70 72 69 6e 74 20 22 6f 62 6a 3a 20 (print "obj:
5df0: 22 20 6f 62 6a 20 22 20 6c 69 6e 3a 20 22 20 6c " obj " lin: " l
5e00: 69 6e 20 22 20 63 6f 6c 3a 20 22 20 63 6f 6c 20 in " col: " col
5e10: 22 20 73 74 61 74 75 73 3a 20 22 20 73 74 61 74 " status: " stat
5e20: 75 73 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 us))))). ;; (
5e30: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
5e40: 74 21 20 6b 65 79 73 2d 6d 61 74 72 69 78 20 22 t! keys-matrix "
5e50: 30 3a 30 22 20 22 52 75 6e 20 4b 65 79 73 22 29 0:0" "Run Keys")
5e60: 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 . (iup:attrib
5e70: 75 74 65 2d 73 65 74 21 20 6b 65 79 73 2d 6d 61 ute-set! keys-ma
5e80: 74 72 69 78 20 22 57 49 44 54 48 30 22 20 30 29 trix "WIDTH0" 0)
5e90: 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 . (iup:attrib
5ea0: 75 74 65 2d 73 65 74 21 20 6b 65 79 73 2d 6d 61 ute-set! keys-ma
5eb0: 74 72 69 78 20 22 30 3a 31 22 20 22 4b 65 79 20 trix "0:1" "Key
5ec0: 4e 61 6d 65 22 29 0a 20 20 20 20 3b 3b 20 28 69 Name"). ;; (i
5ed0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
5ee0: 21 20 6b 65 79 73 2d 6d 61 74 72 69 78 20 22 57 ! keys-matrix "W
5ef0: 49 44 54 48 31 22 20 22 31 30 30 22 29 0a 20 20 IDTH1" "100").
5f00: 20 20 3b 3b 20 66 69 6c 6c 20 69 6e 20 6b 65 79 ;; fill in key
5f10: 73 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 s. (for-each
5f20: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 . (lambda (v
5f30: 61 72 29 0a 20 20 20 20 20 20 20 3b 3b 20 28 69 ar). ;; (i
5f40: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
5f50: 21 20 6b 65 79 73 2d 6d 61 74 72 69 78 20 22 41 ! keys-matrix "A
5f60: 44 44 4c 49 4e 22 20 28 63 6f 6e 63 20 63 75 72 DDLIN" (conc cur
5f70: 72 2d 72 6f 77 2d 6e 75 6d 29 29 0a 20 20 20 20 r-row-num)).
5f80: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
5f90: 65 2d 73 65 74 21 20 6b 65 79 73 2d 6d 61 74 72 e-set! keys-matr
5fa0: 69 78 20 28 63 6f 6e 63 20 63 75 72 72 2d 72 6f ix (conc curr-ro
5fb0: 77 2d 6e 75 6d 20 22 3a 30 22 29 20 63 75 72 72 w-num ":0") curr
5fc0: 2d 72 6f 77 2d 6e 75 6d 29 0a 20 20 20 20 20 20 -row-num).
5fd0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
5fe0: 73 65 74 21 20 6b 65 79 73 2d 6d 61 74 72 69 78 set! keys-matrix
5ff0: 20 28 63 6f 6e 63 20 63 75 72 72 2d 72 6f 77 2d (conc curr-row-
6000: 6e 75 6d 20 22 3a 31 22 29 20 76 61 72 29 0a 20 num ":1") var).
6010: 20 20 20 20 20 20 28 73 65 74 21 20 63 75 72 72 (set! curr
6020: 2d 72 6f 77 2d 6e 75 6d 20 28 2b 20 31 20 63 75 -row-num (+ 1 cu
6030: 72 72 2d 72 6f 77 2d 6e 75 6d 29 29 29 20 3b 3b rr-row-num))) ;;
6040: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
6050: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 66 69 65 *configdat* "fie
6060: 6c 64 73 22 20 76 61 72 29 29 29 0a 20 20 20 20 lds" var))).
6070: 20 6b 65 79 2d 76 61 6c 73 29 0a 20 20 20 20 28 key-vals). (
6080: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
6090: 74 21 20 6b 65 79 73 2d 6d 61 74 72 69 78 20 22 t! keys-matrix "
60a0: 57 49 44 54 48 44 45 46 22 20 22 34 30 22 29 0a WIDTHDEF" "40").
60b0: 20 20 20 20 6b 65 79 73 2d 6d 61 74 72 69 78 29 keys-matrix)
60c0: 29 0a 0a 3b 3b 20 53 65 63 74 69 6f 6e 20 74 6f )..;; Section to
60d0: 20 74 61 62 6c 65 0a 28 64 65 66 69 6e 65 20 28 table.(define (
60e0: 64 63 6f 6d 6d 6f 6e 3a 73 65 63 74 69 6f 6e 2d dcommon:section-
60f0: 6d 61 74 72 69 78 20 72 61 77 63 6f 6e 66 69 67 matrix rawconfig
6100: 20 73 65 63 74 69 6f 6e 6e 61 6d 65 20 76 61 72 sectionname var
6110: 63 6f 6c 6e 61 6d 65 20 76 61 6c 63 6f 6c 6e 61 colname valcolna
6120: 6d 65 20 23 21 6b 65 79 20 28 74 69 74 6c 65 20 me #!key (title
6130: 23 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 #f)). (let* ((c
6140: 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 20 20 20 31 urr-row-num 1
6150: 29 0a 20 20 20 20 20 20 20 20 20 28 6b 65 79 2d ). (key-
6160: 76 61 6c 73 20 20 20 20 20 20 20 20 28 63 6f 6e vals (con
6170: 66 69 67 66 3a 73 65 63 74 69 6f 6e 2d 76 61 72 figf:section-var
6180: 73 20 72 61 77 63 6f 6e 66 69 67 20 73 65 63 74 s rawconfig sect
6190: 69 6f 6e 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 ionname)).
61a0: 20 20 20 28 73 65 63 74 69 6f 6e 2d 6d 61 74 72 (section-matr
61b0: 69 78 20 20 28 69 75 70 3a 6d 61 74 72 69 78 0a ix (iup:matrix.
61c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61d0: 20 20 20 20 20 20 20 20 20 20 20 23 3a 61 6c 69 #:ali
61e0: 67 6e 6d 65 6e 74 31 20 22 41 4c 45 46 54 22 0a gnment1 "ALEFT".
61f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6200: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 23 3a ;; #:
6210: 65 78 70 61 6e 64 20 22 59 45 53 22 20 3b 3b 20 expand "YES" ;;
6220: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 20 20 20 "HORIZONTAL".
6230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6240: 20 20 20 20 20 20 20 20 23 3a 6e 75 6d 63 6f 6c #:numcol
6250: 20 31 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 1.
6260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 3a #:
6270: 6e 75 6d 6c 69 6e 20 28 6c 65 6e 67 74 68 20 6b numlin (length k
6280: 65 79 2d 76 61 6c 73 29 0a 20 20 20 20 20 20 20 ey-vals).
6290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62a0: 20 20 20 20 23 3a 6e 75 6d 63 6f 6c 2d 76 69 73 #:numcol-vis
62b0: 69 62 6c 65 20 31 0a 20 20 20 20 20 20 20 20 20 ible 1.
62c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62d0: 20 20 23 3a 6e 75 6d 6c 69 6e 2d 76 69 73 69 62 #:numlin-visib
62e0: 6c 65 20 28 6d 69 6e 20 31 30 20 28 6c 65 6e 67 le (min 10 (leng
62f0: 74 68 20 6b 65 79 2d 76 61 6c 73 29 29 0a 09 09 th key-vals))...
6300: 09 20 20 20 23 3a 73 63 72 6f 6c 6c 62 61 72 20 . #:scrollbar
6310: 22 59 45 53 22 29 29 29 0a 20 20 20 20 28 69 75 "YES"))). (iu
6320: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
6330: 20 73 65 63 74 69 6f 6e 2d 6d 61 74 72 69 78 20 section-matrix
6340: 22 30 3a 30 22 20 76 61 72 63 6f 6c 6e 61 6d 65 "0:0" varcolname
6350: 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 ). (iup:attri
6360: 62 75 74 65 2d 73 65 74 21 20 73 65 63 74 69 6f bute-set! sectio
6370: 6e 2d 6d 61 74 72 69 78 20 22 30 3a 31 22 20 76 n-matrix "0:1" v
6380: 61 6c 63 6f 6c 6e 61 6d 65 29 0a 20 20 20 20 28 alcolname). (
6390: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
63a0: 74 21 20 73 65 63 74 69 6f 6e 2d 6d 61 74 72 69 t! section-matri
63b0: 78 20 22 57 49 44 54 48 31 22 20 22 32 30 30 22 x "WIDTH1" "200"
63c0: 29 0a 20 20 20 20 3b 3b 20 66 69 6c 6c 20 69 6e ). ;; fill in
63d0: 20 6b 65 79 73 0a 20 20 20 20 28 66 6f 72 2d 65 keys. (for-e
63e0: 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 ach . (lambd
63f0: 61 20 28 76 61 72 29 0a 20 20 20 20 20 20 20 3b a (var). ;
6400: 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 ; (iup:attribute
6410: 2d 73 65 74 21 20 6b 65 79 73 2d 6d 61 74 72 69 -set! keys-matri
6420: 78 20 22 41 44 44 4c 49 4e 22 20 28 63 6f 6e 63 x "ADDLIN" (conc
6430: 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 29 29 0a curr-row-num)).
6440: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 (iup:attr
6450: 69 62 75 74 65 2d 73 65 74 21 20 73 65 63 74 69 ibute-set! secti
6460: 6f 6e 2d 6d 61 74 72 69 78 20 28 63 6f 6e 63 20 on-matrix (conc
6470: 63 75 72 72 2d 72 6f 77 2d 6e 75 6d 20 22 3a 30 curr-row-num ":0
6480: 22 29 20 76 61 72 29 0a 20 20 20 20 20 20 20 28 ") var). (
6490: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
64a0: 74 21 20 73 65 63 74 69 6f 6e 2d 6d 61 74 72 69 t! section-matri
64b0: 78 20 28 63 6f 6e 63 20 63 75 72 72 2d 72 6f 77 x (conc curr-row
64c0: 2d 6e 75 6d 20 22 3a 31 22 29 20 28 63 6f 6e 66 -num ":1") (conf
64d0: 69 67 66 3a 6c 6f 6f 6b 75 70 20 72 61 77 63 6f igf:lookup rawco
64e0: 6e 66 69 67 20 73 65 63 74 69 6f 6e 6e 61 6d 65 nfig sectionname
64f0: 20 76 61 72 29 29 0a 20 20 20 20 20 20 20 28 73 var)). (s
6500: 65 74 21 20 63 75 72 72 2d 72 6f 77 2d 6e 75 6d et! curr-row-num
6510: 20 28 2b 20 31 20 63 75 72 72 2d 72 6f 77 2d 6e (+ 1 curr-row-n
6520: 75 6d 29 29 29 20 3b 3b 20 28 63 6f 6e 66 69 67 um))) ;; (config
6530: 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
6540: 61 74 2a 20 22 66 69 65 6c 64 73 22 20 76 61 72 at* "fields" var
6550: 29 29 29 0a 20 20 20 20 20 6b 65 79 2d 76 61 6c ))). key-val
6560: 73 29 0a 20 20 20 20 28 69 75 70 3a 76 62 6f 78 s). (iup:vbox
6570: 0a 20 20 20 20 20 28 69 75 70 3a 6c 61 62 65 6c . (iup:label
6580: 20 28 69 66 20 74 69 74 6c 65 20 74 69 74 6c 65 (if title title
6590: 20 28 63 6f 6e 63 20 22 53 65 74 74 69 6e 67 73 (conc "Settings
65a0: 20 66 72 6f 6d 20 5b 22 20 73 65 63 74 69 6f 6e from [" section
65b0: 6e 61 6d 65 20 22 5d 22 29 29 20 20 0a 20 20 20 name "]")) .
65c0: 20 20 20 20 20 20 09 3b 3b 20 23 3a 73 69 7a 65 .;; #:size
65d0: 20 20 20 22 35 78 22 0a 20 20 20 20 20 20 20 20 "5x".
65e0: 20 09 23 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 .#:expand "HORI
65f0: 5a 4f 4e 54 41 4c 22 0a 20 20 20 20 20 20 20 20 ZONTAL".
6600: 20 09 29 0a 20 20 20 20 20 73 65 63 74 69 6f 6e .). section
6610: 2d 6d 61 74 72 69 78 29 29 29 0a 20 20 20 20 0a -matrix))). .
6620: 3b 3b 20 47 65 6e 65 72 61 6c 20 64 61 74 61 0a ;; General data.
6630: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d ;;.(define (dcom
6640: 6d 6f 6e 3a 67 65 6e 65 72 61 6c 2d 69 6e 66 6f mon:general-info
6650: 29 0a 20 20 28 6c 65 74 20 28 28 67 65 6e 65 72 ). (let ((gener
6660: 61 6c 2d 6d 61 74 72 69 78 20 28 69 75 70 3a 6d al-matrix (iup:m
6670: 61 74 72 69 78 0a 09 09 09 20 23 3a 61 6c 69 67 atrix.... #:alig
6680: 6e 6d 65 6e 74 31 20 22 41 4c 45 46 54 22 0a 09 nment1 "ALEFT"..
6690: 09 09 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 .. #:expand "YES
66a0: 22 20 3b 3b 20 22 48 4f 52 49 5a 4f 4e 54 41 4c " ;; "HORIZONTAL
66b0: 22 0a 09 09 09 20 23 3a 6e 75 6d 63 6f 6c 20 31 ".... #:numcol 1
66c0: 0a 09 09 09 20 23 3a 6e 75 6d 6c 69 6e 20 32 0a .... #:numlin 2.
66d0: 09 09 09 20 23 3a 6e 75 6d 63 6f 6c 2d 76 69 73 ... #:numcol-vis
66e0: 69 62 6c 65 20 31 0a 09 09 09 20 23 3a 6e 75 6d ible 1.... #:num
66f0: 6c 69 6e 2d 76 69 73 69 62 6c 65 20 32 29 29 29 lin-visible 2)))
6700: 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 . (iup:attrib
6710: 75 74 65 2d 73 65 74 21 20 67 65 6e 65 72 61 6c ute-set! general
6720: 2d 6d 61 74 72 69 78 20 22 57 49 44 54 48 31 22 -matrix "WIDTH1"
6730: 20 22 31 35 30 22 29 0a 20 20 20 20 28 69 75 70 "150"). (iup
6740: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
6750: 67 65 6e 65 72 61 6c 2d 6d 61 74 72 69 78 20 22 general-matrix "
6760: 30 3a 31 22 20 22 41 62 6f 75 74 20 74 68 69 73 0:1" "About this
6770: 20 4d 65 67 61 74 65 73 74 20 61 72 65 61 22 29 Megatest area")
6780: 20 0a 20 20 20 20 3b 3b 20 55 73 65 72 20 28 74 . ;; User (t
6790: 68 69 73 20 69 73 20 6e 6f 74 20 61 6c 77 61 79 his is not alway
67a0: 73 20 6f 62 76 69 6f 75 73 20 2d 20 69 74 20 69 s obvious - it i
67b0: 73 20 63 6f 6d 6d 6f 6e 20 74 6f 20 72 75 6e 20 s common to run
67c0: 61 73 20 61 20 64 69 66 66 65 72 65 6e 74 20 75 as a different u
67d0: 73 65 72 0a 20 20 20 20 28 69 75 70 3a 61 74 74 ser. (iup:att
67e0: 72 69 62 75 74 65 2d 73 65 74 21 20 67 65 6e 65 ribute-set! gene
67f0: 72 61 6c 2d 6d 61 74 72 69 78 20 22 31 3a 30 22 ral-matrix "1:0"
6800: 20 22 55 73 65 72 22 29 0a 20 20 20 20 28 69 75 "User"). (iu
6810: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
6820: 20 67 65 6e 65 72 61 6c 2d 6d 61 74 72 69 78 20 general-matrix
6830: 22 31 3a 31 22 20 28 63 75 72 72 65 6e 74 2d 75 "1:1" (current-u
6840: 73 65 72 2d 6e 61 6d 65 29 29 0a 20 20 20 20 3b ser-name)). ;
6850: 3b 20 4d 65 67 61 74 65 73 74 20 61 72 65 61 0a ; Megatest area.
6860: 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 ;; (iup:attr
6870: 69 62 75 74 65 2d 73 65 74 21 20 67 65 6e 65 72 ibute-set! gener
6880: 61 6c 2d 6d 61 74 72 69 78 20 22 32 3a 30 22 20 al-matrix "2:0"
6890: 22 41 72 65 61 22 29 0a 20 20 20 20 3b 3b 20 28 "Area"). ;; (
68a0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
68b0: 74 21 20 67 65 6e 65 72 61 6c 2d 6d 61 74 72 69 t! general-matri
68c0: 78 20 22 32 3a 31 22 20 2a 74 6f 70 70 61 74 68 x "2:1" *toppath
68d0: 2a 29 0a 20 20 20 20 3b 3b 20 4d 65 67 61 74 65 *). ;; Megate
68e0: 73 74 20 76 65 72 73 69 6f 6e 0a 20 20 20 20 28 st version. (
68f0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
6900: 74 21 20 67 65 6e 65 72 61 6c 2d 6d 61 74 72 69 t! general-matri
6910: 78 20 22 32 3a 30 22 20 22 56 65 72 73 69 6f 6e x "2:0" "Version
6920: 22 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74 72 "). (iup:attr
6930: 69 62 75 74 65 2d 73 65 74 21 20 67 65 6e 65 72 ibute-set! gener
6940: 61 6c 2d 6d 61 74 72 69 78 20 22 32 3a 31 22 20 al-matrix "2:1"
6950: 28 63 6f 6e 63 20 6d 65 67 61 74 65 73 74 2d 76 (conc megatest-v
6960: 65 72 73 69 6f 6e 20 22 2d 22 20 28 73 75 62 73 ersion "-" (subs
6970: 74 72 69 6e 67 20 6d 65 67 61 74 65 73 74 2d 66 tring megatest-f
6980: 6f 73 73 69 6c 2d 68 61 73 68 20 30 20 34 29 29 ossil-hash 0 4))
6990: 29 0a 0a 20 20 20 20 67 65 6e 65 72 61 6c 2d 6d ).. general-m
69a0: 61 74 72 69 78 29 29 0a 0a 28 64 65 66 69 6e 65 atrix))..(define
69b0: 20 28 64 63 6f 6d 6d 6f 6e 3a 72 75 6e 2d 73 74 (dcommon:run-st
69c0: 61 74 73 20 63 6f 6d 6d 6f 6e 64 61 74 20 74 61 ats commondat ta
69d0: 62 64 61 74 20 23 21 6b 65 79 20 28 74 61 62 2d bdat #!key (tab-
69e0: 6e 75 6d 20 23 66 29 29 0a 20 20 28 6c 65 74 2a num #f)). (let*
69f0: 20 28 28 73 74 61 74 73 2d 6d 61 74 72 69 78 20 ((stats-matrix
6a00: 28 69 75 70 3a 6d 61 74 72 69 78 20 65 78 70 61 (iup:matrix expa
6a10: 6e 64 3a 20 22 59 45 53 22 29 29 0a 09 20 28 63 nd: "YES")).. (c
6a20: 68 61 6e 67 65 64 20 20 20 20 20 20 23 66 29 0a hanged #f).
6a30: 09 20 28 73 74 61 74 73 2d 75 70 64 61 74 65 72 . (stats-updater
6a40: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 (lambda ()....
6a50: 28 69 66 20 28 64 61 73 68 62 6f 61 72 64 3a 64 (if (dashboard:d
6a60: 61 74 61 62 61 73 65 2d 63 68 61 6e 67 65 64 3f atabase-changed?
6a70: 20 63 6f 6d 6d 6f 6e 64 61 74 20 74 61 62 64 61 commondat tabda
6a80: 74 20 63 6f 6e 74 65 78 74 2d 6b 65 79 3a 20 27 t context-key: '
6a90: 72 75 6e 2d 73 74 61 74 73 29 0a 09 09 09 20 20 run-stats)....
6aa0: 20 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 2d 73 (let* ((run-s
6ab0: 74 61 74 73 20 20 20 20 28 72 6d 74 3a 67 65 74 tats (rmt:get
6ac0: 2d 72 75 6e 2d 73 74 61 74 73 29 29 0a 09 09 09 -run-stats))....
6ad0: 09 20 20 20 20 28 69 6e 64 69 63 65 73 20 20 20 . (indices
6ae0: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 73 70 61 72 73 (common:spars
6af0: 65 2d 6c 69 73 74 2d 67 65 6e 65 72 61 74 65 2d e-list-generate-
6b00: 69 6e 64 65 78 20 72 75 6e 2d 73 74 61 74 73 29 index run-stats)
6b10: 29 20 3b 3b 20 20 70 72 6f 63 3a 20 73 65 74 2d ) ;; proc: set-
6b20: 63 65 6c 6c 29 29 0a 09 09 09 09 20 20 20 20 28 cell))..... (
6b30: 72 6f 77 2d 69 6e 64 69 63 65 73 20 20 28 63 61 row-indices (ca
6b40: 72 20 69 6e 64 69 63 65 73 29 29 0a 09 09 09 09 r indices)).....
6b50: 20 20 20 20 28 63 6f 6c 2d 69 6e 64 69 63 65 73 (col-indices
6b60: 20 20 28 63 61 64 72 20 69 6e 64 69 63 65 73 29 (cadr indices)
6b70: 29 0a 09 09 09 09 20 20 20 20 28 6d 61 78 2d 72 )..... (max-r
6b80: 6f 77 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c ow (if (nul
6b90: 6c 3f 20 72 6f 77 2d 69 6e 64 69 63 65 73 29 20 l? row-indices)
6ba0: 31 20 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 20 28 6d 1 (common:max (m
6bb0: 61 70 20 63 61 64 72 20 72 6f 77 2d 69 6e 64 69 ap cadr row-indi
6bc0: 63 65 73 29 29 29 29 0a 09 09 09 09 20 20 20 20 ces)))).....
6bd0: 28 6d 61 78 2d 63 6f 6c 20 20 20 20 20 20 28 69 (max-col (i
6be0: 66 20 28 6e 75 6c 6c 3f 20 63 6f 6c 2d 69 6e 64 f (null? col-ind
6bf0: 69 63 65 73 29 20 31 20 0a 09 09 09 09 09 09 20 ices) 1 .......
6c00: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 6d 61 78 (common:max
6c10: 20 28 6d 61 70 20 63 61 64 72 20 63 6f 6c 2d 69 (map cadr col-i
6c20: 6e 64 69 63 65 73 29 29 29 29 0a 09 09 09 09 20 ndices)))).....
6c30: 20 20 20 28 6d 61 78 2d 76 69 73 69 62 6c 65 20 (max-visible
6c40: 20 28 6d 61 78 20 28 2d 20 28 64 62 6f 61 72 64 (max (- (dboard
6c50: 3a 74 61 62 64 61 74 2d 6e 75 6d 2d 74 65 73 74 :tabdat-num-test
6c60: 73 20 74 61 62 64 61 74 29 20 31 35 29 20 33 29 s tabdat) 15) 3)
6c70: 29 0a 09 09 09 09 20 20 20 20 28 6d 61 78 2d 63 )..... (max-c
6c80: 6f 6c 2d 76 69 73 20 20 28 69 66 20 28 3e 20 6d ol-vis (if (> m
6c90: 61 78 2d 63 6f 6c 20 31 30 29 20 31 30 20 6d 61 ax-col 10) 10 ma
6ca0: 78 2d 63 6f 6c 29 29 0a 09 09 09 09 20 20 20 20 x-col)).....
6cb0: 28 6e 75 6d 72 6f 77 73 20 20 20 20 20 20 31 29 (numrows 1)
6cc0: 0a 09 09 09 09 20 20 20 20 28 6e 75 6d 63 6f 6c ..... (numcol
6cd0: 73 20 20 20 20 20 20 31 29 29 0a 09 09 09 20 20 s 1))....
6ce0: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
6cf0: 75 74 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d ute-set! stats-m
6d00: 61 74 72 69 78 20 22 43 4c 45 41 52 56 41 4c 55 atrix "CLEARVALU
6d10: 45 22 20 22 43 4f 4e 54 45 4e 54 53 22 29 0a 09 E" "CONTENTS")..
6d20: 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 .. (iup:at
6d30: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 61 tribute-set! sta
6d40: 74 73 2d 6d 61 74 72 69 78 20 22 4e 55 4d 43 4f ts-matrix "NUMCO
6d50: 4c 22 20 6d 61 78 2d 63 6f 6c 20 29 0a 09 09 09 L" max-col )....
6d60: 20 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 (iup:attr
6d70: 69 62 75 74 65 2d 73 65 74 21 20 73 74 61 74 73 ibute-set! stats
6d80: 2d 6d 61 74 72 69 78 20 22 4e 55 4d 4c 49 4e 22 -matrix "NUMLIN"
6d90: 20 28 69 66 20 28 3c 20 6d 61 78 2d 72 6f 77 20 (if (< max-row
6da0: 6d 61 78 2d 76 69 73 69 62 6c 65 29 20 6d 61 78 max-visible) max
6db0: 2d 76 69 73 69 62 6c 65 20 6d 61 78 2d 72 6f 77 -visible max-row
6dc0: 29 29 20 3b 3b 20 6d 69 6e 20 6f 66 20 32 30 0a )) ;; min of 20.
6dd0: 09 09 09 20 20 20 20 20 20 20 28 69 75 70 3a 61 ... (iup:a
6de0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 ttribute-set! st
6df0: 61 74 73 2d 6d 61 74 72 69 78 20 22 4e 55 4d 43 ats-matrix "NUMC
6e00: 4f 4c 5f 56 49 53 49 42 4c 45 22 20 6d 61 78 2d OL_VISIBLE" max-
6e10: 63 6f 6c 2d 76 69 73 29 0a 09 09 09 20 20 20 20 col-vis)....
6e20: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
6e30: 65 2d 73 65 74 21 20 73 74 61 74 73 2d 6d 61 74 e-set! stats-mat
6e40: 72 69 78 20 22 4e 55 4d 4c 49 4e 5f 56 49 53 49 rix "NUMLIN_VISI
6e50: 42 4c 45 22 20 28 69 66 20 28 3e 20 6d 61 78 2d BLE" (if (> max-
6e60: 72 6f 77 20 6d 61 78 2d 76 69 73 69 62 6c 65 29 row max-visible)
6e70: 20 6d 61 78 2d 76 69 73 69 62 6c 65 20 6d 61 78 max-visible max
6e80: 2d 72 6f 77 29 29 0a 0a 09 09 09 20 20 20 20 20 -row)).....
6e90: 20 20 3b 3b 20 52 6f 77 20 6c 61 62 65 6c 73 0a ;; Row labels.
6ea0: 09 09 09 20 20 20 20 20 20 20 28 66 6f 72 2d 65 ... (for-e
6eb0: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 69 6e 64 ach (lambda (ind
6ec0: 29 0a 09 09 09 09 09 20 20 20 28 6c 65 74 2a 20 )...... (let*
6ed0: 28 28 6e 61 6d 65 20 28 63 61 72 20 69 6e 64 29 ((name (car ind)
6ee0: 29 0a 09 09 09 09 09 09 20 20 28 6e 75 6d 20 20 )....... (num
6ef0: 28 63 61 64 72 20 69 6e 64 29 29 0a 09 09 09 09 (cadr ind)).....
6f00: 09 09 20 20 28 6b 65 79 20 20 28 63 6f 6e 63 20 .. (key (conc
6f10: 6e 75 6d 20 22 3a 30 22 29 29 29 0a 09 09 09 09 num ":0"))).....
6f20: 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 . (if (not (
6f30: 65 71 75 61 6c 3f 20 28 69 75 70 3a 61 74 74 72 equal? (iup:attr
6f40: 69 62 75 74 65 20 73 74 61 74 73 2d 6d 61 74 72 ibute stats-matr
6f50: 69 78 20 6b 65 79 29 20 6e 61 6d 65 29 29 0a 09 ix key) name))..
6f60: 09 09 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 ..... (begin....
6f70: 09 09 09 20 20 20 28 73 65 74 21 20 63 68 61 6e ... (set! chan
6f80: 67 65 64 20 23 74 29 0a 09 09 09 09 09 09 20 20 ged #t).......
6f90: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
6fa0: 73 65 74 21 20 73 74 61 74 73 2d 6d 61 74 72 69 set! stats-matri
6fb0: 78 20 6b 65 79 20 6e 61 6d 65 29 29 29 29 29 0a x key name))))).
6fc0: 09 09 09 09 09 20 72 6f 77 2d 69 6e 64 69 63 65 ..... row-indice
6fd0: 73 29 0a 0a 09 09 09 20 20 20 20 20 20 20 3b 3b s)..... ;;
6fe0: 20 43 6f 6c 20 6c 61 62 65 6c 73 0a 09 09 09 20 Col labels....
6ff0: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
7000: 28 6c 61 6d 62 64 61 20 28 69 6e 64 29 0a 09 09 (lambda (ind)...
7010: 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 6e 61 ... (let* ((na
7020: 6d 65 20 28 63 61 72 20 69 6e 64 29 29 0a 09 09 me (car ind))...
7030: 09 09 09 09 20 20 28 6e 75 6d 20 20 28 63 61 64 .... (num (cad
7040: 72 20 69 6e 64 29 29 0a 09 09 09 09 09 09 20 20 r ind)).......
7050: 28 6b 65 79 20 20 28 63 6f 6e 63 20 22 30 3a 22 (key (conc "0:"
7060: 20 6e 75 6d 29 29 29 0a 09 09 09 09 09 20 20 20 num)))......
7070: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 (if (not (equa
7080: 6c 3f 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 l? (iup:attribut
7090: 65 20 73 74 61 74 73 2d 6d 61 74 72 69 78 20 6b e stats-matrix k
70a0: 65 79 29 20 6e 61 6d 65 29 29 0a 09 09 09 09 09 ey) name))......
70b0: 09 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 . (begin.......
70c0: 20 20 28 73 65 74 21 20 63 68 61 6e 67 65 64 20 (set! changed
70d0: 23 74 29 0a 09 09 09 09 09 09 20 20 20 28 69 75 #t)....... (iu
70e0: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
70f0: 20 73 74 61 74 73 2d 6d 61 74 72 69 78 20 6b 65 stats-matrix ke
7100: 79 20 6e 61 6d 65 29 29 29 29 29 0a 09 09 09 09 y name))))).....
7110: 09 20 63 6f 6c 2d 69 6e 64 69 63 65 73 29 0a 0a . col-indices)..
7120: 09 09 09 20 20 20 20 20 20 20 3b 3b 20 43 65 6c ... ;; Cel
7130: 6c 20 63 6f 6e 74 65 6e 74 73 0a 09 09 09 20 20 l contents....
7140: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 (for-each (
7150: 6c 61 6d 62 64 61 20 28 65 6e 74 72 79 29 0a 09 lambda (entry)..
7160: 09 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 72 .... (let* ((r
7170: 6f 77 2d 6e 61 6d 65 20 28 63 61 72 20 65 6e 74 ow-name (car ent
7180: 72 79 29 29 0a 09 09 09 09 09 09 20 20 28 63 6f ry))....... (co
7190: 6c 2d 6e 61 6d 65 20 28 63 61 64 72 20 65 6e 74 l-name (cadr ent
71a0: 72 79 29 29 0a 09 09 09 09 09 09 20 20 28 76 61 ry))....... (va
71b0: 6c 75 65 20 20 20 20 28 63 61 64 64 72 20 65 6e lue (caddr en
71c0: 74 72 79 29 29 0a 09 09 09 09 09 09 20 20 28 72 try))....... (r
71d0: 6f 77 2d 6e 75 6d 20 20 28 63 61 64 72 20 28 61 ow-num (cadr (a
71e0: 73 73 6f 63 20 72 6f 77 2d 6e 61 6d 65 20 72 6f ssoc row-name ro
71f0: 77 2d 69 6e 64 69 63 65 73 29 29 29 0a 09 09 09 w-indices)))....
7200: 09 09 09 20 20 28 63 6f 6c 2d 6e 75 6d 20 20 28 ... (col-num (
7210: 63 61 64 72 20 28 61 73 73 6f 63 20 63 6f 6c 2d cadr (assoc col-
7220: 6e 61 6d 65 20 63 6f 6c 2d 69 6e 64 69 63 65 73 name col-indices
7230: 29 29 29 0a 09 09 09 09 09 09 20 20 28 6b 65 79 )))....... (key
7240: 20 20 20 20 20 20 28 63 6f 6e 63 20 72 6f 77 2d (conc row-
7250: 6e 75 6d 20 22 3a 22 20 63 6f 6c 2d 6e 75 6d 29 num ":" col-num)
7260: 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 ))...... (if
7270: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 69 (not (equal? (i
7280: 75 70 3a 61 74 74 72 69 62 75 74 65 20 73 74 61 up:attribute sta
7290: 74 73 2d 6d 61 74 72 69 78 20 6b 65 79 29 20 76 ts-matrix key) v
72a0: 61 6c 75 65 29 29 0a 09 09 09 09 09 09 20 28 62 alue))....... (b
72b0: 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 28 73 egin....... (s
72c0: 65 74 21 20 63 68 61 6e 67 65 64 20 23 74 29 0a et! changed #t).
72d0: 09 09 09 09 09 09 20 20 20 28 69 75 70 3a 61 74 ...... (iup:at
72e0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 61 tribute-set! sta
72f0: 74 73 2d 6d 61 74 72 69 78 20 6b 65 79 20 76 61 ts-matrix key va
7300: 6c 75 65 29 29 29 29 29 0a 09 09 09 09 09 20 72 lue)))))...... r
7310: 75 6e 2d 73 74 61 74 73 29 0a 09 09 09 20 20 20 un-stats)....
7320: 20 20 20 20 28 69 66 20 63 68 61 6e 67 65 64 20 (if changed
7330: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
7340: 65 74 21 20 73 74 61 74 73 2d 6d 61 74 72 69 78 et! stats-matrix
7350: 20 22 52 45 44 52 41 57 22 20 22 41 4c 4c 22 29 "REDRAW" "ALL")
7360: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
7370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7380: 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 64 62 6f )))). ;; (dbo
7390: 61 72 64 3a 63 6f 6d 6d 6f 6e 64 61 74 2d 70 6c ard:commondat-pl
73a0: 65 61 73 65 2d 75 70 64 61 74 65 2d 73 65 74 21 ease-update-set!
73b0: 20 63 6f 6d 6d 6f 6e 64 61 74 20 23 74 29 20 3b commondat #t) ;
73c0: 3b 20 66 6f 72 63 65 20 72 65 64 72 61 77 20 6f ; force redraw o
73d0: 6e 20 66 69 72 73 74 20 70 61 73 73 20 0a 20 20 n first pass .
73e0: 20 20 3b 3b 20 28 6d 61 72 6b 2d 66 6f 72 2d 75 ;; (mark-for-u
73f0: 70 64 61 74 65 20 74 61 62 64 61 74 29 0a 20 20 pdate tabdat).
7400: 20 20 3b 3b 20 28 73 74 61 74 73 2d 75 70 64 61 ;; (stats-upda
7410: 74 65 72 29 0a 20 20 20 20 28 64 62 6f 61 72 64 ter). (dboard
7420: 3a 63 6f 6d 6d 6f 6e 64 61 74 2d 61 64 64 2d 75 :commondat-add-u
7430: 70 64 61 74 65 72 20 63 6f 6d 6d 6f 6e 64 61 74 pdater commondat
7440: 20 73 74 61 74 73 2d 75 70 64 61 74 65 72 20 74 stats-updater t
7450: 61 62 2d 6e 75 6d 3a 20 74 61 62 2d 6e 75 6d 29 ab-num: tab-num)
7460: 0a 20 20 20 20 3b 3b 20 28 73 65 74 21 20 64 61 . ;; (set! da
7470: 73 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 73 shboard:update-s
7480: 75 6d 6d 61 72 79 2d 74 61 62 20 75 70 64 61 74 ummary-tab updat
7490: 65 72 29 0a 20 20 20 20 28 69 75 70 3a 61 74 74 er). (iup:att
74a0: 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 61 74 ribute-set! stat
74b0: 73 2d 6d 61 74 72 69 78 20 22 57 49 44 54 48 44 s-matrix "WIDTHD
74c0: 45 46 22 20 22 34 30 22 29 0a 20 20 20 20 28 69 EF" "40"). (i
74d0: 75 70 3a 76 62 6f 78 0a 20 20 20 20 20 3b 3b 20 up:vbox. ;;
74e0: 28 69 75 70 3a 6c 61 62 65 6c 20 22 52 75 6e 20 (iup:label "Run
74f0: 73 74 61 74 69 73 74 69 63 73 22 20 20 23 3a 65 statistics" #:e
7500: 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 xpand "HORIZONTA
7510: 4c 22 29 0a 20 20 20 20 20 73 74 61 74 73 2d 6d L"). stats-m
7520: 61 74 72 69 78 29 29 29 0a 0a 28 64 65 66 69 6e atrix)))..(defin
7530: 65 20 28 64 63 6f 6d 6d 6f 6e 3a 73 65 72 76 65 e (dcommon:serve
7540: 72 73 2d 74 61 62 6c 65 20 63 6f 6d 6d 6f 6e 64 rs-table commond
7550: 61 74 20 74 61 62 64 61 74 29 0a 20 20 28 6c 65 at tabdat). (le
7560: 74 2a 20 28 28 63 6f 6c 6e 75 6d 20 20 20 20 20 t* ((colnum
7570: 20 20 20 20 30 29 0a 09 20 28 72 6f 77 6e 75 6d 0).. (rownum
7580: 20 20 20 20 20 20 20 20 20 30 29 0a 09 20 28 73 0).. (s
7590: 65 72 76 65 72 73 2d 6d 61 74 72 69 78 20 28 69 ervers-matrix (i
75a0: 75 70 3a 6d 61 74 72 69 78 20 23 3a 65 78 70 61 up:matrix #:expa
75b0: 6e 64 20 22 59 45 53 22 0a 09 09 09 09 20 20 20 nd "YES".....
75c0: 20 20 23 3a 6e 75 6d 63 6f 6c 20 37 0a 09 09 09 #:numcol 7....
75d0: 09 20 20 20 20 20 23 3a 6e 75 6d 63 6f 6c 2d 76 . #:numcol-v
75e0: 69 73 69 62 6c 65 20 37 0a 09 09 09 09 20 20 20 isible 7.....
75f0: 20 20 23 3a 6e 75 6d 6c 69 6e 2d 76 69 73 69 62 #:numlin-visib
7600: 6c 65 20 35 0a 09 09 09 09 20 20 20 20 20 29 29 le 5..... ))
7610: 0a 09 20 28 63 6f 6c 6e 61 6d 65 73 20 20 20 20 .. (colnames
7620: 20 20 20 28 6c 69 73 74 20 22 49 64 22 20 22 4d (list "Id" "M
7630: 54 76 65 72 22 20 22 50 69 64 22 20 22 48 6f 73 Tver" "Pid" "Hos
7640: 74 22 20 22 49 6e 74 65 72 66 61 63 65 3a 4f 75 t" "Interface:Ou
7650: 74 50 6f 72 74 22 20 22 52 75 6e 54 69 6d 65 22 tPort" "RunTime"
7660: 20 22 53 74 61 74 65 22 20 22 52 75 6e 49 64 22 "State" "RunId"
7670: 29 29 0a 09 20 28 75 70 64 61 74 65 72 20 20 20 )).. (updater
7680: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a (lambda ().
7690: 09 09 09 20 20 20 28 69 66 20 28 64 61 73 68 62 ... (if (dashb
76a0: 6f 61 72 64 3a 6d 6f 6e 69 74 6f 72 2d 63 68 61 oard:monitor-cha
76b0: 6e 67 65 64 3f 20 63 6f 6d 6d 6f 6e 64 61 74 20 nged? commondat
76c0: 74 61 62 64 61 74 29 0a 09 09 09 20 20 20 20 20 tabdat)....
76d0: 20 20 28 6c 65 74 20 28 28 73 65 72 76 65 72 73 (let ((servers
76e0: 20 20 28 73 65 72 76 65 72 3a 67 65 74 2d 6c 69 (server:get-li
76f0: 73 74 20 2a 74 6f 70 70 61 74 68 2a 20 6c 69 6d st *toppath* lim
7700: 69 74 3a 20 31 30 29 29 29 0a 09 09 09 09 20 28 it: 10)))..... (
7710: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
7720: 74 21 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69 t! servers-matri
7730: 78 20 22 4e 55 4d 4c 49 4e 22 20 28 6c 65 6e 67 x "NUMLIN" (leng
7740: 74 68 20 73 65 72 76 65 72 73 29 29 0a 09 09 09 th servers))....
7750: 09 20 3b 3b 20 28 73 65 74 21 20 63 6f 6c 6e 75 . ;; (set! colnu
7760: 6d 20 30 29 0a 09 09 09 09 20 3b 3b 20 28 66 6f m 0)..... ;; (fo
7770: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
7780: 63 6f 6c 6e 61 6d 65 29 0a 09 09 09 09 20 3b 3b colname)..... ;;
7790: 20 20 20 20 09 20 3b 3b 20 28 70 72 69 6e 74 20 . ;; (print
77a0: 22 63 6f 6c 6e 75 6d 3a 20 22 20 63 6f 6c 6e 75 "colnum: " colnu
77b0: 6d 20 22 20 63 6f 6c 6e 61 6d 65 3a 20 22 20 63 m " colname: " c
77c0: 6f 6c 6e 61 6d 65 29 0a 09 09 09 09 20 3b 3b 20 olname)..... ;;
77d0: 20 20 20 09 20 28 69 75 70 3a 61 74 74 72 69 62 . (iup:attrib
77e0: 75 74 65 2d 73 65 74 21 20 73 65 72 76 65 72 73 ute-set! servers
77f0: 2d 6d 61 74 72 69 78 20 28 63 6f 6e 63 20 22 30 -matrix (conc "0
7800: 3a 22 20 63 6f 6c 6e 75 6d 29 20 63 6f 6c 6e 61 :" colnum) colna
7810: 6d 65 29 0a 09 09 09 09 20 3b 3b 20 20 20 20 09 me)..... ;; .
7820: 20 28 73 65 74 21 20 63 6f 6c 6e 75 6d 20 28 2b (set! colnum (+
7830: 20 31 20 63 6f 6c 6e 75 6d 29 29 29 0a 09 09 09 1 colnum)))....
7840: 09 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 63 . ;; c
7850: 6f 6c 6e 61 6d 65 73 29 0a 09 09 09 09 20 28 73 olnames)..... (s
7860: 65 74 21 20 72 6f 77 6e 75 6d 20 31 29 0a 09 09 et! rownum 1)...
7870: 09 09 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 .. (for-each ...
7880: 09 09 20 20 28 6c 61 6d 62 64 61 20 28 73 65 72 .. (lambda (ser
7890: 76 65 72 29 0a 09 09 09 09 20 20 20 20 28 73 65 ver)..... (se
78a0: 74 21 20 63 6f 6c 6e 75 6d 20 30 29 0a 09 09 09 t! colnum 0)....
78b0: 09 20 20 20 20 28 6d 61 74 63 68 2d 6c 65 74 20 . (match-let
78c0: 28 28 28 6d 6f 64 2d 74 69 6d 65 20 68 6f 73 74 (((mod-time host
78d0: 20 70 6f 72 74 20 73 74 61 72 74 2d 74 69 6d 65 port start-time
78e0: 20 70 69 64 29 0a 09 09 09 09 09 09 20 73 65 72 pid)....... ser
78f0: 76 65 72 29 29 0a 09 09 09 09 20 20 20 20 20 20 ver)).....
7900: 28 6c 65 74 2a 20 28 28 75 70 74 69 6d 65 20 20 (let* ((uptime
7910: 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (- (current-seco
7920: 6e 64 73 29 20 6d 6f 64 2d 74 69 6d 65 29 29 0a nds) mod-time)).
7930: 09 09 09 09 09 20 20 20 20 20 28 72 75 6e 74 69 ..... (runti
7940: 6d 65 20 28 69 66 20 73 74 61 72 74 2d 74 69 6d me (if start-tim
7950: 65 0a 09 09 09 09 09 09 09 20 20 28 2d 20 6d 6f e........ (- mo
7960: 64 2d 74 69 6d 65 20 73 74 61 72 74 2d 74 69 6d d-time start-tim
7970: 65 29 0a 09 09 09 09 09 09 09 20 20 30 29 29 0a e)........ 0)).
7980: 09 09 09 09 09 20 20 20 20 20 28 76 61 6c 73 20 ..... (vals
7990: 28 6c 69 73 74 20 22 2d 22 20 20 3b 3b 20 28 76 (list "-" ;; (v
79a0: 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 72 ector-ref server
79b0: 20 30 29 20 3b 3b 20 49 64 0a 09 09 09 09 09 09 0) ;; Id.......
79c0: 09 20 22 2d 22 20 20 3b 3b 20 28 76 65 63 74 6f . "-" ;; (vecto
79d0: 72 2d 72 65 66 20 73 65 72 76 65 72 20 39 29 20 r-ref server 9)
79e0: 3b 3b 20 4d 54 2d 56 65 72 0a 09 09 09 09 09 09 ;; MT-Ver.......
79f0: 09 20 70 69 64 20 20 3b 3b 20 28 76 65 63 74 6f . pid ;; (vecto
7a00: 72 2d 72 65 66 20 73 65 72 76 65 72 20 31 29 20 r-ref server 1)
7a10: 3b 3b 20 50 69 64 0a 09 09 09 09 09 09 09 20 68 ;; Pid........ h
7a20: 6f 73 74 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 ost ;; (vector-r
7a30: 65 66 20 73 65 72 76 65 72 20 32 29 20 3b 3b 20 ef server 2) ;;
7a40: 48 6f 73 74 6e 61 6d 65 0a 09 09 09 09 09 09 09 Hostname........
7a50: 20 28 63 6f 6e 63 20 68 6f 73 74 20 22 3a 22 20 (conc host ":"
7a60: 70 6f 72 74 29 20 3b 3b 20 28 63 6f 6e 63 20 28 port) ;; (conc (
7a70: 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 65 vector-ref serve
7a80: 72 20 33 29 20 22 3a 22 20 28 76 65 63 74 6f 72 r 3) ":" (vector
7a90: 2d 72 65 66 20 73 65 72 76 65 72 20 34 29 29 20 -ref server 4))
7aa0: 3b 3b 20 49 50 3a 50 6f 72 74 0a 09 09 09 09 09 ;; IP:Port......
7ab0: 09 09 20 28 73 65 63 6f 6e 64 73 2d 3e 68 72 2d .. (seconds->hr-
7ac0: 6d 69 6e 2d 73 65 63 20 72 75 6e 74 69 6d 65 29 min-sec runtime)
7ad0: 20 3b 3b 20 28 2d 20 28 63 75 72 72 65 6e 74 2d ;; (- (current-
7ae0: 73 65 63 6f 6e 64 73 29 20 73 74 61 72 74 2d 74 seconds) start-t
7af0: 69 6d 65 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 ime)) ;; (vector
7b00: 2d 72 65 66 20 73 65 72 76 65 72 20 36 29 29 29 -ref server 6)))
7b10: 0a 09 09 09 09 09 09 09 20 28 63 6f 6e 64 0a 09 ........ (cond..
7b20: 09 09 09 09 09 09 20 20 28 28 3c 20 75 70 74 69 ...... ((< upti
7b30: 6d 65 20 35 29 20 20 22 61 6c 69 76 65 22 29 0a me 5) "alive").
7b40: 09 09 09 09 09 09 09 20 20 28 28 3c 20 75 70 74 ....... ((< upt
7b50: 69 6d 65 20 31 36 29 20 22 70 72 6f 62 61 62 6c ime 16) "probabl
7b60: 79 20 61 6c 69 76 65 22 29 3b 3b 20 6c 65 73 73 y alive");; less
7b70: 20 74 68 61 6e 20 31 35 20 73 65 63 6f 6e 64 73 than 15 seconds
7b80: 20 73 69 6e 63 65 20 6d 6f 64 2c 20 63 61 6c 6c since mod, call
7b90: 20 69 74 20 61 6c 69 76 65 20 28 76 65 63 74 6f it alive (vecto
7ba0: 72 2d 72 65 66 20 73 65 72 76 65 72 20 38 29 20 r-ref server 8)
7bb0: 3b 3b 20 53 74 61 74 65 0a 09 09 09 09 09 09 09 ;; State........
7bc0: 20 20 28 65 6c 73 65 20 22 64 65 61 64 22 29 29 (else "dead"))
7bd0: 0a 09 09 09 09 09 09 09 20 22 2d 22 20 3b 3b 20 ........ "-" ;;
7be0: 28 76 65 63 74 6f 72 2d 72 65 66 20 73 65 72 76 (vector-ref serv
7bf0: 65 72 20 31 32 29 20 20 3b 3b 20 52 75 6e 49 64 er 12) ;; RunId
7c00: 0a 09 09 09 09 09 09 09 20 29 29 29 0a 09 09 09 ........ )))....
7c10: 09 09 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d ..(for-each (lam
7c20: 62 64 61 20 28 76 61 6c 29 0a 09 09 09 09 09 09 bda (val).......
7c30: 20 20 20 20 28 6c 65 74 2a 20 28 28 72 6f 77 2d (let* ((row-
7c40: 63 6f 6c 20 28 63 6f 6e 63 20 72 6f 77 6e 75 6d col (conc rownum
7c50: 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 29 0a 09 09 ":" colnum))...
7c60: 09 09 09 09 09 20 20 20 28 63 75 72 72 2d 76 61 ..... (curr-va
7c70: 6c 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 l (iup:attribute
7c80: 20 73 65 72 76 65 72 73 2d 6d 61 74 72 69 78 20 servers-matrix
7c90: 72 6f 77 2d 63 6f 6c 29 29 29 0a 09 09 09 09 09 row-col)))......
7ca0: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
7cb0: 28 65 71 75 61 6c 3f 20 28 63 6f 6e 63 20 76 61 (equal? (conc va
7cc0: 6c 29 20 63 75 72 72 2d 76 61 6c 29 29 0a 09 09 l) curr-val))...
7cd0: 09 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 ..... (begin...
7ce0: 09 09 09 09 09 20 20 20 20 28 69 75 70 3a 61 74 ..... (iup:at
7cf0: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 72 tribute-set! ser
7d00: 76 65 72 73 2d 6d 61 74 72 69 78 20 72 6f 77 2d vers-matrix row-
7d10: 63 6f 6c 20 76 61 6c 29 0a 09 09 09 09 09 09 09 col val)........
7d20: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
7d30: 74 65 2d 73 65 74 21 20 73 65 72 76 65 72 73 2d te-set! servers-
7d40: 6d 61 74 72 69 78 20 22 46 49 54 54 4f 54 45 58 matrix "FITTOTEX
7d50: 54 22 20 28 63 6f 6e 63 20 22 43 22 20 63 6f 6c T" (conc "C" col
7d60: 6e 75 6d 29 29 29 29 0a 09 09 09 09 09 09 20 20 num)))).......
7d70: 20 20 20 20 28 73 65 74 21 20 63 6f 6c 6e 75 6d (set! colnum
7d80: 20 28 2b 20 31 20 63 6f 6c 6e 75 6d 29 29 29 29 (+ 1 colnum))))
7d90: 0a 09 09 09 09 09 09 20 20 76 61 6c 73 29 0a 09 ....... vals)..
7da0: 09 09 09 09 28 73 65 74 21 20 72 6f 77 6e 75 6d ....(set! rownum
7db0: 20 28 2b 20 72 6f 77 6e 75 6d 20 31 29 29 29 0a (+ rownum 1))).
7dc0: 09 09 09 09 20 20 20 20 20 20 28 69 75 70 3a 61 .... (iup:a
7dd0: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 65 ttribute-set! se
7de0: 72 76 65 72 73 2d 6d 61 74 72 69 78 20 22 52 45 rvers-matrix "RE
7df0: 44 52 41 57 22 20 22 41 4c 4c 22 29 29 29 0a 09 DRAW" "ALL")))..
7e00: 09 09 09 20 20 20 20 28 73 6f 72 74 20 73 65 72 ... (sort ser
7e10: 76 65 72 73 20 28 6c 61 6d 62 64 61 20 28 61 20 vers (lambda (a
7e20: 62 29 28 3e 20 28 63 61 72 20 61 29 28 63 61 72 b)(> (car a)(car
7e30: 20 62 29 29 29 29 29 29 29 29 29 29 0a 20 20 20 b)))))))))).
7e40: 20 28 73 65 74 21 20 63 6f 6c 6e 75 6d 20 30 29 (set! colnum 0)
7e50: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 . (for-each (
7e60: 6c 61 6d 62 64 61 20 28 63 6f 6c 6e 61 6d 65 29 lambda (colname)
7e70: 0a 09 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 ...(iup:attribut
7e80: 65 2d 73 65 74 21 20 73 65 72 76 65 72 73 2d 6d e-set! servers-m
7e90: 61 74 72 69 78 20 28 63 6f 6e 63 20 22 30 3a 22 atrix (conc "0:"
7ea0: 20 63 6f 6c 6e 75 6d 29 20 63 6f 6c 6e 61 6d 65 colnum) colname
7eb0: 29 0a 09 09 28 69 75 70 3a 61 74 74 72 69 62 75 )...(iup:attribu
7ec0: 74 65 2d 73 65 74 21 20 73 65 72 76 65 72 73 2d te-set! servers-
7ed0: 6d 61 74 72 69 78 20 22 46 49 54 54 4f 54 45 58 matrix "FITTOTEX
7ee0: 54 22 20 28 63 6f 6e 63 20 22 43 22 20 63 6f 6c T" (conc "C" col
7ef0: 6e 75 6d 29 29 0a 09 09 28 73 65 74 21 20 63 6f num))...(set! co
7f00: 6c 6e 75 6d 20 28 2b 20 63 6f 6c 6e 75 6d 20 31 lnum (+ colnum 1
7f10: 29 29 29 0a 09 20 20 20 20 20 20 63 6f 6c 6e 61 ))).. colna
7f20: 6d 65 73 29 0a 20 20 20 20 3b 3b 20 28 73 65 74 mes). ;; (set
7f30: 21 20 64 61 73 68 62 6f 61 72 64 3a 75 70 64 61 ! dashboard:upda
7f40: 74 65 2d 73 65 72 76 65 72 73 2d 74 61 62 6c 65 te-servers-table
7f50: 20 75 70 64 61 74 65 72 29 20 0a 20 20 20 20 28 updater) . (
7f60: 64 62 6f 61 72 64 3a 63 6f 6d 6d 6f 6e 64 61 74 dboard:commondat
7f70: 2d 61 64 64 2d 75 70 64 61 74 65 72 20 63 6f 6d -add-updater com
7f80: 6d 6f 6e 64 61 74 20 75 70 64 61 74 65 72 29 0a mondat updater).
7f90: 20 20 20 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 ;; (iup:attr
7fa0: 69 62 75 74 65 2d 73 65 74 21 20 73 65 72 76 65 ibute-set! serve
7fb0: 72 73 2d 6d 61 74 72 69 78 20 22 57 49 44 54 48 rs-matrix "WIDTH
7fc0: 44 45 46 22 20 22 34 30 22 29 0a 20 20 20 20 3b DEF" "40"). ;
7fd0: 3b 20 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20 ; (iup:hbox.
7fe0: 20 3b 3b 20 20 20 28 69 75 70 3a 76 62 6f 78 0a ;; (iup:vbox.
7ff0: 20 20 20 20 3b 3b 20 20 20 20 28 69 75 70 3a 62 ;; (iup:b
8000: 75 74 74 6f 6e 20 22 53 74 61 72 74 22 0a 20 20 utton "Start".
8010: 20 20 3b 3b 20 20 20 20 20 20 09 20 20 3b 3b 20 ;; . ;;
8020: 23 3a 73 69 7a 65 20 22 35 30 78 22 0a 20 20 20 #:size "50x".
8030: 20 3b 3b 20 20 20 20 20 20 09 20 20 23 3a 65 78 ;; . #:ex
8040: 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20 20 3b pand "YES". ;
8050: 3b 20 20 20 20 20 20 09 20 20 23 3a 61 63 74 69 ; . #:acti
8060: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
8070: 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09 20 . ;; ..
8080: 20 20 20 20 28 6c 65 74 20 28 28 63 6d 64 20 28 (let ((cmd (
8090: 63 6f 6e 63 20 3b 3b 20 22 78 74 65 72 6d 20 2d conc ;; "xterm -
80a0: 67 65 6f 6d 65 74 72 79 20 31 38 30 78 32 30 20 geometry 180x20
80b0: 2d 65 20 5c 22 22 0a 20 20 20 20 3b 3b 20 20 20 -e \"". ;;
80c0: 20 20 20 09 09 09 09 20 20 20 20 20 20 22 6d 65 .... "me
80d0: 67 61 74 65 73 74 20 2d 73 65 72 76 65 72 20 2d gatest -server -
80e0: 20 26 22 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 &"))). ;;
80f0: 20 20 20 09 09 09 09 20 20 20 20 20 20 3b 3b 20 .... ;;
8100: 22 3b 65 63 68 6f 20 50 72 65 73 73 20 61 6e 79 ";echo Press any
8110: 20 6b 65 79 20 74 6f 20 63 6f 6e 74 69 6e 75 65 key to continue
8120: 3b 62 61 73 68 20 2d 63 20 27 72 65 61 64 20 2d ;bash -c 'read -
8130: 6e 20 31 20 2d 73 27 5c 22 20 26 22 29 29 29 0a n 1 -s'\" &"))).
8140: 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09 20 20 ;; ..
8150: 20 20 20 20 20 28 73 79 73 74 65 6d 20 63 6d 64 (system cmd
8160: 29 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 28 )))). ;; (
8170: 69 75 70 3a 62 75 74 74 6f 6e 20 22 53 74 6f 70 iup:button "Stop
8180: 22 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09 20 ". ;; .
8190: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
81a0: 20 20 20 20 3b 3b 20 20 20 20 20 20 09 20 20 3b ;; . ;
81b0: 3b 20 23 3a 73 69 7a 65 20 22 35 30 78 22 0a 20 ; #:size "50x".
81c0: 20 20 20 3b 3b 20 20 20 20 20 20 09 20 20 23 3a ;; . #:
81d0: 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 action (lambda (
81e0: 6f 62 6a 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 obj). ;;
81f0: 20 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 63 .. (let ((c
8200: 6d 64 20 28 63 6f 6e 63 20 3b 3b 20 22 78 74 65 md (conc ;; "xte
8210: 72 6d 20 2d 67 65 6f 6d 65 74 72 79 20 31 38 30 rm -geometry 180
8220: 78 32 30 20 2d 65 20 5c 22 22 0a 20 20 20 20 3b x20 -e \"". ;
8230: 3b 20 20 20 20 20 20 09 09 09 09 20 20 20 20 20 ; ....
8240: 20 22 6d 65 67 61 74 65 73 74 20 2d 73 74 6f 70 "megatest -stop
8250: 2d 73 65 72 76 65 72 20 30 20 26 22 29 29 29 0a -server 0 &"))).
8260: 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09 09 09 ;; ....
8270: 20 20 20 20 20 20 3b 3b 20 22 3b 65 63 68 6f 20 ;; ";echo
8280: 50 72 65 73 73 20 61 6e 79 20 6b 65 79 20 74 6f Press any key to
8290: 20 63 6f 6e 74 69 6e 75 65 3b 62 61 73 68 20 2d continue;bash -
82a0: 63 20 27 72 65 61 64 20 2d 6e 20 31 20 2d 73 27 c 'read -n 1 -s'
82b0: 5c 22 20 26 22 29 29 29 0a 20 20 20 20 3b 3b 20 \" &"))). ;;
82c0: 20 20 20 20 20 09 09 20 20 20 20 20 20 20 28 73 .. (s
82d0: 79 73 74 65 6d 20 63 6d 64 29 29 29 29 0a 20 20 ystem cmd)))).
82e0: 20 20 3b 3b 20 20 20 20 28 69 75 70 3a 62 75 74 ;; (iup:but
82f0: 74 6f 6e 20 22 52 65 73 74 61 72 74 22 0a 20 20 ton "Restart".
8300: 20 20 3b 3b 20 20 20 20 20 20 09 20 20 23 3a 65 ;; . #:e
8310: 78 70 61 6e 64 20 22 59 45 53 22 0a 20 20 20 20 xpand "YES".
8320: 3b 3b 20 20 20 20 20 20 09 20 20 3b 3b 20 23 3a ;; . ;; #:
8330: 73 69 7a 65 20 22 35 30 78 22 0a 20 20 20 20 3b size "50x". ;
8340: 3b 20 20 20 20 20 20 09 20 20 23 3a 61 63 74 69 ; . #:acti
8350: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 29 on (lambda (obj)
8360: 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09 20 . ;; ..
8370: 20 20 20 20 28 6c 65 74 20 28 28 63 6d 64 20 28 (let ((cmd (
8380: 63 6f 6e 63 20 3b 3b 20 22 78 74 65 72 6d 20 2d conc ;; "xterm -
8390: 67 65 6f 6d 65 74 72 79 20 31 38 30 78 32 30 20 geometry 180x20
83a0: 2d 65 20 5c 22 22 0a 20 20 20 20 3b 3b 20 20 20 -e \"". ;;
83b0: 20 20 20 09 09 09 09 20 20 20 20 20 20 22 6d 65 .... "me
83c0: 67 61 74 65 73 74 20 2d 73 74 6f 70 2d 73 65 72 gatest -stop-ser
83d0: 76 65 72 20 30 3b 6d 65 67 61 74 65 73 74 20 2d ver 0;megatest -
83e0: 73 65 72 76 65 72 20 2d 20 26 22 29 29 29 0a 20 server - &"))).
83f0: 20 20 20 3b 3b 20 20 20 20 20 20 09 09 09 09 20 ;; ....
8400: 20 20 20 20 20 3b 3b 20 22 3b 65 63 68 6f 20 50 ;; ";echo P
8410: 72 65 73 73 20 61 6e 79 20 6b 65 79 20 74 6f 20 ress any key to
8420: 63 6f 6e 74 69 6e 75 65 3b 62 61 73 68 20 2d 63 continue;bash -c
8430: 20 27 72 65 61 64 20 2d 6e 20 31 20 2d 73 27 5c 'read -n 1 -s'\
8440: 22 20 26 22 29 29 29 0a 20 20 20 20 3b 3b 20 20 " &"))). ;;
8450: 20 20 20 20 09 09 20 20 20 20 20 20 20 28 73 79 .. (sy
8460: 73 74 65 6d 20 63 6d 64 29 29 29 29 29 0a 20 20 stem cmd))))).
8470: 20 20 3b 3b 20 20 20 20 73 65 72 76 65 72 73 2d ;; servers-
8480: 6d 61 74 72 69 78 0a 20 20 20 20 3b 3b 20 20 20 matrix. ;;
8490: 29 29 29 0a 20 20 20 20 73 65 72 76 65 72 73 2d ))). servers-
84a0: 6d 61 74 72 69 78 0a 20 20 20 20 29 29 0a 0a 3b matrix. ))..;
84b0: 3b 20 54 68 65 20 6d 61 69 6e 20 6d 65 6e 75 0a ; The main menu.
84c0: 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e (define (dcommon
84d0: 3a 6d 61 69 6e 2d 6d 65 6e 75 29 0a 20 20 28 69 :main-menu). (i
84e0: 75 70 3a 6d 65 6e 75 20 3b 3b 20 61 20 6d 65 6e up:menu ;; a men
84f0: 75 20 69 73 20 61 20 73 70 65 63 69 61 6c 20 61 u is a special a
8500: 74 74 72 69 62 75 74 65 20 74 6f 20 61 20 64 69 ttribute to a di
8510: 61 6c 6f 67 20 28 74 68 69 6e 6b 20 47 6e 6f 6d alog (think Gnom
8520: 65 20 70 75 74 74 69 6e 67 20 74 68 65 20 6d 65 e putting the me
8530: 6e 75 20 61 74 20 73 63 72 65 65 6e 20 74 6f 70 nu at screen top
8540: 29 0a 20 20 20 28 69 75 70 3a 6d 65 6e 75 2d 69 ). (iup:menu-i
8550: 74 65 6d 20 22 46 69 6c 65 73 22 20 28 69 75 70 tem "Files" (iup
8560: 3a 6d 65 6e 75 20 20 20 3b 3b 20 4e 6f 74 65 20 :menu ;; Note
8570: 74 68 61 74 20 79 6f 75 20 63 61 6e 20 75 73 65 that you can use
8580: 20 65 69 74 68 65 72 20 23 3a 61 63 74 69 6f 6e either #:action
8590: 20 6f 72 20 61 63 74 69 6f 6e 3a 20 66 6f 72 20 or action: for
85a0: 6f 70 74 69 6f 6e 73 0a 09 09 09 20 20 20 28 69 options.... (i
85b0: 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 4f 70 up:menu-item "Op
85c0: 65 6e 22 20 20 61 63 74 69 6f 6e 3a 20 28 6c 61 en" action: (la
85d0: 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 09 09 mbda (obj)......
85e0: 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 61 72 .. (let* ((ar
85f0: 65 61 2d 6e 61 6d 65 20 28 69 75 70 3a 74 65 78 ea-name (iup:tex
8600: 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 22 48 tbox #:expand "H
8610: 4f 52 49 5a 4f 4e 54 41 4c 22 29 29 0a 09 09 09 ORIZONTAL"))....
8620: 09 09 09 09 09 20 20 20 28 66 64 20 20 20 20 20 ..... (fd
8630: 20 20 20 28 69 75 70 3a 66 69 6c 65 2d 64 69 61 (iup:file-dia
8640: 6c 6f 67 20 23 3a 64 69 61 6c 6f 67 74 79 70 65 log #:dialogtype
8650: 20 22 44 49 52 22 29 29 0a 09 09 09 09 09 09 09 "DIR"))........
8660: 09 20 20 20 28 74 6f 70 20 20 20 20 20 20 20 28 . (top (
8670: 69 75 70 3a 73 68 6f 77 20 66 64 20 23 3a 6d 6f iup:show fd #:mo
8680: 64 61 6c 3f 20 22 59 45 53 22 29 29 29 0a 09 09 dal? "YES")))...
8690: 09 09 09 09 09 20 20 20 20 20 20 28 69 75 70 3a ..... (iup:
86a0: 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 61 attribute-set! a
86b0: 72 65 61 2d 6e 61 6d 65 20 22 56 41 4c 55 45 22 rea-name "VALUE"
86c0: 20 3b 3b 20 77 61 73 20 73 6f 75 72 63 65 2d 74 ;; was source-t
86d0: 62 2c 20 6e 6f 20 69 64 65 61 20 77 68 61 74 20 b, no idea what
86e0: 69 73 20 63 6f 72 72 65 63 74 0a 09 09 09 09 09 is correct......
86f0: 09 09 09 09 09 20 20 28 69 75 70 3a 61 74 74 72 ..... (iup:attr
8700: 69 62 75 74 65 20 66 64 20 22 56 41 4c 55 45 22 ibute fd "VALUE"
8710: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 ))........
8720: 28 69 75 70 3a 64 65 73 74 72 6f 79 21 20 66 64 (iup:destroy! fd
8730: 29 29 29 29 0a 09 09 09 20 20 20 3b 3b 20 28 6c )))).... ;; (l
8740: 61 6d 62 64 61 20 28 6f 62 6a 29 0a 09 09 09 20 ambda (obj)....
8750: 20 20 3b 3b 20 20 28 69 75 70 3a 73 68 6f 77 20 ;; (iup:show
8760: 28 69 75 70 3a 66 69 6c 65 2d 64 69 61 6c 6f 67 (iup:file-dialog
8770: 29 29 0a 09 09 09 20 20 20 3b 3b 20 20 28 70 72 )).... ;; (pr
8780: 69 6e 74 20 22 46 69 6c 65 2d 3e 6f 70 65 6e 20 int "File->open
8790: 22 20 6f 62 6a 29 29 29 0a 09 09 09 20 20 20 28 " obj))).... (
87a0: 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 53 iup:menu-item "S
87b0: 61 76 65 22 20 20 23 3a 61 63 74 69 6f 6e 20 28 ave" #:action (
87c0: 6c 61 6d 62 64 61 20 28 6f 62 6a 29 28 70 72 69 lambda (obj)(pri
87d0: 6e 74 20 22 46 69 6c 65 2d 3e 73 61 76 65 20 22 nt "File->save "
87e0: 20 6f 62 6a 29 29 29 0a 09 09 09 20 20 20 28 69 obj))).... (i
87f0: 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 45 78 up:menu-item "Ex
8800: 69 74 22 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c it" #:action (l
8810: 61 6d 62 64 61 20 28 6f 62 6a 29 28 65 78 69 74 ambda (obj)(exit
8820: 29 29 29 29 29 0a 20 20 20 28 69 75 70 3a 6d 65 ))))). (iup:me
8830: 6e 75 2d 69 74 65 6d 20 22 54 6f 6f 6c 73 22 20 nu-item "Tools"
8840: 28 69 75 70 3a 6d 65 6e 75 0a 09 09 09 20 20 20 (iup:menu....
8850: 28 69 75 70 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 (iup:menu-item "
8860: 43 72 65 61 74 65 20 6e 65 77 20 62 6c 61 68 22 Create new blah"
8870: 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d 62 64 #:action (lambd
8880: 61 20 28 6f 62 6a 29 28 70 72 69 6e 74 20 22 54 a (obj)(print "T
8890: 6f 6f 6c 73 2d 3e 6e 65 77 20 62 6c 61 68 22 29 ools->new blah")
88a0: 29 29 0a 09 09 09 20 20 20 3b 3b 20 28 69 75 70 )).... ;; (iup
88b0: 3a 6d 65 6e 75 2d 69 74 65 6d 20 22 53 68 6f 77 :menu-item "Show
88c0: 20 64 69 61 6c 6f 67 22 20 20 20 20 20 23 3a 61 dialog" #:a
88d0: 63 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f ction (lambda (o
88e0: 62 6a 29 0a 09 09 09 20 20 20 3b 3b 20 20 09 09 bj).... ;; ..
88f0: 09 09 09 20 20 20 28 73 68 6f 77 20 6d 65 73 73 ... (show mess
8900: 61 67 65 2d 77 69 6e 64 6f 77 0a 09 09 09 20 20 age-window....
8910: 20 3b 3b 20 20 09 09 09 09 09 20 20 20 20 20 23 ;; ..... #
8920: 3a 6d 6f 64 61 6c 3f 20 23 74 0a 09 09 09 20 20 :modal? #t....
8930: 20 3b 3b 20 20 09 09 09 09 09 20 20 20 20 20 3b ;; ..... ;
8940: 3b 20 73 65 74 20 70 6f 73 69 74 6f 6e 20 75 73 ; set positon us
8950: 69 6e 67 20 63 6f 6f 72 64 69 6e 61 74 65 73 20 ing coordinates
8960: 6f 72 20 63 65 6e 74 65 72 2c 20 73 74 61 72 74 or center, start
8970: 2c 20 74 6f 70 2c 20 6c 65 66 74 2c 20 65 6e 64 , top, left, end
8980: 2c 20 62 6f 74 74 6f 6d 2c 20 72 69 67 68 74 2c , bottom, right,
8990: 20 70 61 72 65 6e 74 2d 63 65 6e 74 65 72 2c 20 parent-center,
89a0: 63 75 72 72 65 6e 74 0a 09 09 09 20 20 20 3b 3b current.... ;;
89b0: 20 20 09 09 09 09 09 20 20 20 20 20 3b 3b 20 23 ..... ;; #
89c0: 3a 78 20 27 6d 6f 75 73 65 0a 09 09 09 20 20 20 :x 'mouse....
89d0: 3b 3b 20 20 09 09 09 09 09 20 20 20 20 20 3b 3b ;; ..... ;;
89e0: 20 23 3a 79 20 27 6d 6f 75 73 65 0a 09 09 09 20 #:y 'mouse....
89f0: 20 20 3b 3b 20 20 29 09 09 09 09 09 20 20 20 20 ;; ).....
8a00: 20 0a 09 09 09 20 20 20 29 29 29 29 0a 0a 3b 3b .... ))))..;;
8a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a50: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 41 4e 56 41 53 ======.;; CANVAS
8a60: 20 53 54 55 46 46 20 46 4f 52 20 54 45 53 54 53 STUFF FOR TESTS
8a70: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
8a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi
8ac0: 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 ne (dcommon:draw
8ad0: 2d 74 65 73 74 20 63 6e 76 20 78 6f 66 66 73 65 -test cnv xoffse
8ae0: 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c 65 66 t yoffset scalef
8af0: 20 78 20 79 20 77 20 68 20 6e 61 6d 65 20 73 65 x y w h name se
8b00: 6c 65 63 74 65 64 29 0a 20 20 28 6c 65 74 2a 20 lected). (let*
8b10: 28 28 6c 6c 78 20 28 64 63 6f 6d 6d 6f 6e 3a 78 ((llx (dcommon:x
8b20: 2d 3e 63 61 6e 76 61 73 20 78 20 73 63 61 6c 65 ->canvas x scale
8b30: 66 20 78 6f 66 66 73 65 74 29 29 0a 09 20 28 6c f xoffset)).. (l
8b40: 6c 79 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e 63 ly (dcommon:y->c
8b50: 61 6e 76 61 73 20 79 20 73 63 61 6c 65 66 20 79 anvas y scalef y
8b60: 6f 66 66 73 65 74 29 29 0a 09 20 28 75 72 78 20 offset)).. (urx
8b70: 28 64 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 (dcommon:x->canv
8b80: 61 73 20 28 2b 20 78 20 77 29 20 73 63 61 6c 65 as (+ x w) scale
8b90: 66 20 78 6f 66 66 73 65 74 29 29 0a 09 20 28 75 f xoffset)).. (u
8ba0: 72 79 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e 63 ry (dcommon:y->c
8bb0: 61 6e 76 61 73 20 28 2b 20 79 20 68 29 20 73 63 anvas (+ y h) sc
8bc0: 61 6c 65 66 20 79 6f 66 66 73 65 74 29 29 29 0a alef yoffset))).
8bd0: 20 20 20 20 28 63 61 6e 76 61 73 2d 74 65 78 74 (canvas-text
8be0: 21 20 63 6e 76 20 28 2b 20 6c 6c 78 20 35 29 28 ! cnv (+ llx 5)(
8bf0: 2b 20 6c 6c 79 20 35 29 20 6e 61 6d 65 29 0a 20 + lly 5) name).
8c00: 20 20 20 28 63 61 6e 76 61 73 2d 72 65 63 74 61 (canvas-recta
8c10: 6e 67 6c 65 21 20 63 6e 76 20 6c 6c 78 20 75 72 ngle! cnv llx ur
8c20: 78 20 6c 6c 79 20 75 72 79 29 0a 20 20 20 20 28 x lly ury). (
8c30: 69 66 20 73 65 6c 65 63 74 65 64 20 28 63 61 6e if selected (can
8c40: 76 61 73 2d 62 6f 78 21 20 63 6e 76 20 6c 6c 78 vas-box! cnv llx
8c50: 20 28 2b 20 6c 6c 78 20 35 29 20 6c 6c 79 20 28 (+ llx 5) lly (
8c60: 2b 20 6c 6c 79 20 35 29 29 29 29 29 0a 0a 28 64 + lly 5)))))..(d
8c70: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 64 efine (dcommon:d
8c80: 72 61 77 2d 61 72 72 6f 77 20 63 6e 76 20 74 65 raw-arrow cnv te
8c90: 73 74 2d 62 6f 78 2d 63 65 6e 74 65 72 20 77 61 st-box-center wa
8ca0: 69 74 6f 6e 2d 63 65 6e 74 65 72 29 0a 20 20 28 iton-center). (
8cb0: 6c 65 74 2a 20 28 28 74 65 73 74 2d 62 6f 78 2d let* ((test-box-
8cc0: 63 65 6e 74 65 72 2d 78 20 28 76 65 63 74 6f 72 center-x (vector
8cd0: 2d 72 65 66 20 74 65 73 74 2d 62 6f 78 2d 63 65 -ref test-box-ce
8ce0: 6e 74 65 72 20 30 29 29 0a 09 20 28 74 65 73 74 nter 0)).. (test
8cf0: 2d 62 6f 78 2d 63 65 6e 74 65 72 2d 79 20 28 76 -box-center-y (v
8d00: 65 63 74 6f 72 2d 72 65 66 20 74 65 73 74 2d 62 ector-ref test-b
8d10: 6f 78 2d 63 65 6e 74 65 72 20 31 29 29 0a 09 20 ox-center 1))..
8d20: 28 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 2d 78 (waiton-center-x
8d30: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 77 (vector-ref w
8d40: 61 69 74 6f 6e 2d 63 65 6e 74 65 72 20 20 20 30 aiton-center 0
8d50: 29 29 0a 09 20 28 77 61 69 74 6f 6e 2d 63 65 6e )).. (waiton-cen
8d60: 74 65 72 2d 79 20 20 20 28 76 65 63 74 6f 72 2d ter-y (vector-
8d70: 72 65 66 20 77 61 69 74 6f 6e 2d 63 65 6e 74 65 ref waiton-cente
8d80: 72 20 20 20 31 29 29 0a 09 20 28 64 65 6c 74 61 r 1)).. (delta
8d90: 2d 79 20 20 20 20 20 20 20 20 20 20 20 28 2d 20 -y (-
8da0: 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 2d 79 20 waiton-center-y
8db0: 74 65 73 74 2d 62 6f 78 2d 63 65 6e 74 65 72 2d test-box-center-
8dc0: 79 29 29 0a 09 20 28 64 65 6c 74 61 2d 78 20 20 y)).. (delta-x
8dd0: 20 20 20 20 20 20 20 20 20 28 2d 20 77 61 69 74 (- wait
8de0: 6f 6e 2d 63 65 6e 74 65 72 2d 78 20 74 65 73 74 on-center-x test
8df0: 2d 62 6f 78 2d 63 65 6e 74 65 72 2d 78 29 29 0a -box-center-x)).
8e00: 09 20 28 61 62 73 2d 64 65 6c 74 61 2d 78 20 20 . (abs-delta-x
8e10: 20 20 20 20 20 28 61 62 73 20 64 65 6c 74 61 2d (abs delta-
8e20: 78 29 29 0a 09 20 28 61 62 73 2d 64 65 6c 74 61 x)).. (abs-delta
8e30: 2d 79 20 20 20 20 20 20 20 28 61 62 73 20 64 65 -y (abs de
8e40: 6c 74 61 2d 79 29 29 0a 09 20 28 75 73 65 2d 64 lta-y)).. (use-d
8e50: 65 6c 74 61 2d 78 20 20 20 20 20 20 20 28 3e 20 elta-x (>
8e60: 61 62 73 2d 64 65 6c 74 61 2d 78 20 61 62 73 2d abs-delta-x abs-
8e70: 64 65 6c 74 61 2d 79 29 29 20 3b 3b 20 75 73 65 delta-y)) ;; use
8e80: 20 74 68 65 20 6c 61 72 67 65 72 20 6f 6e 65 0a the larger one.
8e90: 09 20 28 64 65 6c 74 61 2d 72 61 74 69 6f 20 20 . (delta-ratio
8ea0: 20 20 20 20 20 28 69 66 20 75 73 65 2d 64 65 6c (if use-del
8eb0: 74 61 2d 78 0a 09 09 09 09 28 69 66 20 28 3e 20 ta-x.....(if (>
8ec0: 61 62 73 2d 64 65 6c 74 61 2d 78 20 30 29 0a 09 abs-delta-x 0)..
8ed0: 09 09 09 20 20 20 20 28 2f 20 61 62 73 2d 64 65 ... (/ abs-de
8ee0: 6c 74 61 2d 79 20 61 62 73 2d 64 65 6c 74 61 2d lta-y abs-delta-
8ef0: 78 29 0a 09 09 09 09 20 20 20 20 31 29 0a 09 09 x)..... 1)...
8f00: 09 09 28 69 66 20 28 3e 20 61 62 73 2d 64 65 6c ..(if (> abs-del
8f10: 74 61 2d 79 20 30 29 0a 09 09 09 09 20 20 20 20 ta-y 0).....
8f20: 28 2f 20 61 62 73 2d 64 65 6c 74 61 2d 78 20 61 (/ abs-delta-x a
8f30: 62 73 2d 64 65 6c 74 61 2d 79 29 0a 09 09 09 09 bs-delta-y).....
8f40: 20 20 20 20 31 29 29 29 0a 09 20 28 78 2d 61 64 1))).. (x-ad
8f50: 6a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 j (i
8f60: 66 20 75 73 65 2d 64 65 6c 74 61 2d 78 0a 09 09 f use-delta-x...
8f70: 09 09 38 0a 09 09 09 09 28 2a 20 64 65 6c 74 61 ..8.....(* delta
8f80: 2d 72 61 74 69 6f 20 38 29 29 29 0a 09 20 28 79 -ratio 8))).. (y
8f90: 2d 61 64 6a 20 20 20 20 20 20 20 20 20 20 20 20 -adj
8fa0: 20 28 69 66 20 75 73 65 2d 64 65 6c 74 61 2d 78 (if use-delta-x
8fb0: 0a 09 09 09 09 28 2a 20 78 2d 61 64 6a 20 64 65 .....(* x-adj de
8fc0: 6c 74 61 2d 72 61 74 69 6f 29 0a 09 09 09 09 38 lta-ratio).....8
8fd0: 29 29 0a 09 20 28 6e 65 77 2d 77 61 69 74 6f 6e )).. (new-waiton
8fe0: 2d 78 20 20 20 20 20 20 28 69 6e 65 78 61 63 74 -x (inexact
8ff0: 2d 3e 65 78 61 63 74 0a 09 09 09 20 20 20 20 20 ->exact....
9000: 28 72 6f 75 6e 64 20 28 69 66 20 28 3e 20 64 65 (round (if (> de
9010: 6c 74 61 2d 78 20 30 29 20 3b 3b 20 68 61 76 65 lta-x 0) ;; have
9020: 20 70 6f 73 69 74 69 76 65 20 78 0a 09 09 09 09 positive x.....
9030: 09 28 2d 20 77 61 69 74 6f 6e 2d 63 65 6e 74 65 .(- waiton-cente
9040: 72 2d 78 20 78 2d 61 64 6a 29 0a 09 09 09 09 09 r-x x-adj)......
9050: 28 2b 20 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 (+ waiton-center
9060: 2d 78 20 78 2d 61 64 6a 29 29 29 29 29 0a 09 20 -x x-adj)))))..
9070: 28 6e 65 77 2d 77 61 69 74 6f 6e 2d 79 20 20 20 (new-waiton-y
9080: 20 20 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 (inexact->exa
9090: 63 74 0a 09 09 09 20 20 20 20 20 28 72 6f 75 6e ct.... (roun
90a0: 64 20 28 69 66 20 28 3e 20 64 65 6c 74 61 2d 79 d (if (> delta-y
90b0: 20 30 29 0a 09 09 09 09 09 28 2d 20 77 61 69 74 0)......(- wait
90c0: 6f 6e 2d 63 65 6e 74 65 72 2d 79 20 79 2d 61 64 on-center-y y-ad
90d0: 6a 29 0a 09 09 09 09 09 28 2b 20 77 61 69 74 6f j)......(+ waito
90e0: 6e 2d 63 65 6e 74 65 72 2d 79 20 79 2d 61 64 6a n-center-y y-adj
90f0: 29 29 29 29 29 29 0a 20 20 3b 3b 20 28 63 61 6e )))))). ;; (can
9100: 76 61 73 2d 6c 69 6e 65 2d 77 69 64 74 68 2d 73 vas-line-width-s
9110: 65 74 21 20 63 6e 76 20 35 29 0a 20 20 28 63 61 et! cnv 5). (ca
9120: 6e 76 61 73 2d 6c 69 6e 65 21 20 63 6e 76 0a 09 nvas-line! cnv..
9130: 09 74 65 73 74 2d 62 6f 78 2d 63 65 6e 74 65 72 .test-box-center
9140: 2d 78 0a 09 09 74 65 73 74 2d 62 6f 78 2d 63 65 -x...test-box-ce
9150: 6e 74 65 72 2d 79 0a 09 09 6e 65 77 2d 77 61 69 nter-y...new-wai
9160: 74 6f 6e 2d 78 0a 09 09 6e 65 77 2d 77 61 69 74 ton-x...new-wait
9170: 6f 6e 2d 79 0a 09 09 29 0a 20 20 28 63 61 6e 76 on-y...). (canv
9180: 61 73 2d 6d 61 72 6b 21 20 63 6e 76 20 6e 65 77 as-mark! cnv new
9190: 2d 77 61 69 74 6f 6e 2d 78 20 6e 65 77 2d 77 61 -waiton-x new-wa
91a0: 69 74 6f 6e 2d 79 29 29 29 0a 0a 28 64 65 66 69 iton-y)))..(defi
91b0: 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d ne (dcommon:get-
91c0: 62 6f 78 2d 63 65 6e 74 65 72 20 62 6f 78 29 0a box-center box).
91d0: 20 20 28 6c 65 74 2a 20 28 28 6c 6c 78 20 20 28 (let* ((llx (
91e0: 6c 69 73 74 2d 72 65 66 20 62 6f 78 20 30 29 29 list-ref box 0))
91f0: 0a 09 20 28 6c 6c 79 20 20 28 6c 69 73 74 2d 72 .. (lly (list-r
9200: 65 66 20 62 6f 78 20 31 29 29 0a 09 20 28 62 6f ef box 1)).. (bo
9210: 78 77 20 28 6c 69 73 74 2d 72 65 66 20 62 6f 78 xw (list-ref box
9220: 20 34 29 29 0a 09 20 28 62 6f 78 68 20 28 6c 69 4)).. (boxh (li
9230: 73 74 2d 72 65 66 20 62 6f 78 20 35 29 29 29 0a st-ref box 5))).
9240: 20 20 20 20 28 76 65 63 74 6f 72 20 28 2b 20 6c (vector (+ l
9250: 6c 78 20 28 2f 20 62 6f 78 77 20 32 29 29 0a 09 lx (/ boxw 2))..
9260: 20 20 20 20 28 2b 20 6c 6c 79 20 28 2f 20 62 6f (+ lly (/ bo
9270: 78 68 20 32 29 29 29 29 29 0a 0a 28 64 65 66 69 xh 2)))))..(defi
9280: 6e 65 2d 69 6e 6c 69 6e 65 20 28 6e 75 6d 2d 3e ne-inline (num->
9290: 69 6e 74 20 6e 75 6d 29 0a 20 20 28 69 6e 65 78 int num). (inex
92a0: 61 63 74 2d 3e 65 78 61 63 74 20 28 72 6f 75 6e act->exact (roun
92b0: 64 20 6e 75 6d 29 29 29 0a 0a 28 64 65 66 69 6e d num)))..(defin
92c0: 65 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d e (dcommon:draw-
92d0: 65 64 67 65 73 20 63 6e 76 20 78 6f 66 66 73 65 edges cnv xoffse
92e0: 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c 65 66 t yoffset scalef
92f0: 20 65 64 67 65 73 29 0a 20 20 28 66 6f 72 2d 65 edges). (for-e
9300: 61 63 68 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 ach. (lambda (
9310: 65 29 0a 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f e). (let loo
9320: 70 20 28 28 78 31 20 28 63 61 72 20 65 29 29 0a p ((x1 (car e)).
9330: 09 09 28 79 31 20 28 63 61 64 72 20 65 29 29 0a ..(y1 (cadr e)).
9340: 09 09 28 78 32 20 23 66 29 0a 09 09 28 79 32 20 ..(x2 #f)...(y2
9350: 23 66 29 0a 09 09 28 74 61 6c 20 28 63 64 64 72 #f)...(tal (cddr
9360: 20 65 29 29 29 0a 20 20 20 20 20 20 20 28 69 66 e))). (if
9370: 20 28 61 6e 64 20 78 31 20 79 31 20 78 32 20 79 (and x1 y1 x2 y
9380: 32 29 0a 09 20 20 20 28 63 61 6e 76 61 73 2d 6c 2).. (canvas-l
9390: 69 6e 65 21 20 0a 09 20 20 20 20 63 6e 76 20 0a ine! .. cnv .
93a0: 09 20 20 20 20 28 6e 75 6d 2d 3e 69 6e 74 20 28 . (num->int (
93b0: 64 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 dcommon:x->canva
93c0: 73 20 78 31 20 73 63 61 6c 65 66 20 78 6f 66 66 s x1 scalef xoff
93d0: 73 65 74 29 29 0a 09 20 20 20 20 28 6e 75 6d 2d set)).. (num-
93e0: 3e 69 6e 74 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d >int (dcommon:y-
93f0: 3e 63 61 6e 76 61 73 20 79 31 20 73 63 61 6c 65 >canvas y1 scale
9400: 66 20 79 6f 66 66 73 65 74 29 29 0a 09 20 20 20 f yoffset))..
9410: 20 28 6e 75 6d 2d 3e 69 6e 74 20 28 64 63 6f 6d (num->int (dcom
9420: 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 73 20 78 32 mon:x->canvas x2
9430: 20 73 63 61 6c 65 66 20 78 6f 66 66 73 65 74 29 scalef xoffset)
9440: 29 0a 09 20 20 20 20 28 6e 75 6d 2d 3e 69 6e 74 ).. (num->int
9450: 20 28 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e 63 61 6e (dcommon:y->can
9460: 76 61 73 20 79 32 20 73 63 61 6c 65 66 20 79 6f vas y2 scalef yo
9470: 66 66 73 65 74 29 29 29 29 20 3b 3b 20 28 6e 75 ffset)))) ;; (nu
9480: 6d 2d 3e 69 6e 74 20 78 31 29 28 6e 75 6d 2d 3e m->int x1)(num->
9490: 69 6e 74 20 79 31 29 28 6e 75 6d 2d 3e 69 6e 74 int y1)(num->int
94a0: 20 78 32 29 28 6e 75 6d 2d 3e 69 6e 74 20 79 32 x2)(num->int y2
94b0: 29 29 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 ))). (if (
94c0: 3c 20 28 6c 65 6e 67 74 68 20 74 61 6c 29 20 32 < (length tal) 2
94d0: 29 0a 09 20 20 20 28 63 61 6e 76 61 73 2d 6d 61 ).. (canvas-ma
94e0: 72 6b 21 20 63 6e 76 0a 09 09 09 20 28 6e 75 6d rk! cnv.... (num
94f0: 2d 3e 69 6e 74 20 28 64 63 6f 6d 6d 6f 6e 3a 78 ->int (dcommon:x
9500: 2d 3e 63 61 6e 76 61 73 20 78 31 20 73 63 61 6c ->canvas x1 scal
9510: 65 66 20 78 6f 66 66 73 65 74 29 29 0a 09 09 09 ef xoffset))....
9520: 20 28 6e 75 6d 2d 3e 69 6e 74 20 28 64 63 6f 6d (num->int (dcom
9530: 6d 6f 6e 3a 79 2d 3e 63 61 6e 76 61 73 20 79 31 mon:y->canvas y1
9540: 20 73 63 61 6c 65 66 20 79 6f 66 66 73 65 74 29 scalef yoffset)
9550: 29 29 20 3b 3b 20 28 6e 75 6d 2d 3e 69 6e 74 20 )) ;; (num->int
9560: 78 31 29 28 6e 75 6d 2d 3e 69 6e 74 20 79 31 29 x1)(num->int y1)
9570: 29 0a 09 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 ).. (loop (car
9580: 20 74 61 6c 29 28 63 61 64 72 20 74 61 6c 29 20 tal)(cadr tal)
9590: 78 31 20 79 31 20 28 63 64 64 72 20 74 61 6c 29 x1 y1 (cddr tal)
95a0: 29 29 29 29 0a 20 20 20 3b 3b 20 28 6d 61 70 20 )))). ;; (map
95b0: 28 6c 61 6d 62 64 61 20 28 65 29 28 6d 61 70 20 (lambda (e)(map
95c0: 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 75 6d 2d (lambda (x)(num-
95d0: 3e 69 6e 74 20 28 2a 20 78 20 73 63 61 6c 65 66 >int (* x scalef
95e0: 29 29 29 20 65 29 29 20 65 64 67 65 73 29 29 29 ))) e)) edges)))
95f0: 0a 20 20 20 65 64 67 65 73 29 29 0a 0a 0a 28 64 . edges))...(d
9600: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 64 efine (dcommon:d
9610: 72 61 77 2d 61 72 72 6f 77 73 20 63 6e 76 20 74 raw-arrows cnv t
9620: 65 73 74 6e 61 6d 65 20 74 65 73 74 73 2d 68 61 estname tests-ha
9630: 73 68 20 74 65 73 74 2d 72 65 63 6f 72 64 73 29 sh test-records)
9640: 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d . (let* ((test-
9650: 62 6f 78 2d 69 6e 66 6f 20 20 20 28 68 61 73 68 box-info (hash
9660: 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 73 -table-ref tests
9670: 2d 68 61 73 68 20 74 65 73 74 6e 61 6d 65 29 29 -hash testname))
9680: 0a 09 20 28 74 65 73 74 2d 62 6f 78 2d 63 65 6e .. (test-box-cen
9690: 74 65 72 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 ter (dcommon:get
96a0: 2d 62 6f 78 2d 63 65 6e 74 65 72 20 74 65 73 74 -box-center test
96b0: 2d 62 6f 78 2d 69 6e 66 6f 29 29 0a 09 20 28 74 -box-info)).. (t
96c0: 65 73 74 2d 72 65 63 6f 72 64 20 20 20 20 20 28 est-record (
96d0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 hash-table-ref t
96e0: 65 73 74 2d 72 65 63 6f 72 64 73 20 74 65 73 74 est-records test
96f0: 6e 61 6d 65 29 29 0a 09 20 28 77 61 69 74 6f 6e name)).. (waiton
9700: 73 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f s (vecto
9710: 72 2d 72 65 66 20 74 65 73 74 2d 72 65 63 6f 72 r-ref test-recor
9720: 64 20 32 29 29 29 0a 20 20 20 20 28 66 6f 72 2d d 2))). (for-
9730: 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 each. (lambd
9740: 61 20 28 77 61 69 74 6f 6e 29 0a 20 20 20 20 20 a (waiton).
9750: 20 20 28 6c 65 74 2a 20 28 28 77 61 69 74 6f 6e (let* ((waiton
9760: 2d 62 6f 78 2d 69 6e 66 6f 20 28 68 61 73 68 2d -box-info (hash-
9770: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
9780: 74 20 74 65 73 74 73 2d 68 61 73 68 20 77 61 69 t tests-hash wai
9790: 74 6f 6e 20 23 66 29 29 0a 09 20 20 20 20 20 20 ton #f))..
97a0: 28 77 61 69 74 6f 6e 2d 63 65 6e 74 65 72 20 20 (waiton-center
97b0: 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 62 6f (dcommon:get-bo
97c0: 78 2d 63 65 6e 74 65 72 20 28 6f 72 20 77 61 69 x-center (or wai
97d0: 74 6f 6e 2d 62 6f 78 2d 69 6e 66 6f 20 74 65 73 ton-box-info tes
97e0: 74 2d 62 6f 78 2d 69 6e 66 6f 29 29 29 29 0a 09 t-box-info))))..
97f0: 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 61 (dcommon:draw-a
9800: 72 72 6f 77 20 63 6e 76 20 74 65 73 74 2d 62 6f rrow cnv test-bo
9810: 78 2d 63 65 6e 74 65 72 20 77 61 69 74 6f 6e 2d x-center waiton-
9820: 63 65 6e 74 65 72 29 29 29 0a 20 20 20 20 20 77 center))). w
9830: 61 69 74 6f 6e 73 29 0a 20 20 20 20 3b 3b 20 28 aitons). ;; (
9840: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
9850: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
9860: 20 22 74 65 73 74 2d 62 6f 78 2d 69 6e 66 6f 3d "test-box-info=
9870: 22 20 74 65 73 74 2d 62 6f 78 2d 69 6e 66 6f 29 " test-box-info)
9880: 0a 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 . ;; (debug:p
9890: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
98a0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 74 65 73 74 2d log-port* "test-
98b0: 72 65 63 6f 72 64 3d 22 20 74 65 73 74 2d 72 65 record=" test-re
98c0: 63 6f 72 64 29 0a 20 20 20 20 29 29 0a 0a 28 64 cord). ))..(d
98d0: 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 65 efine (dcommon:e
98e0: 73 74 69 6d 61 74 65 2d 73 63 61 6c 65 20 73 69 stimate-scale si
98f0: 7a 65 78 20 73 69 7a 65 79 20 6f 72 69 67 69 6e zex sizey origin
9900: 78 20 6f 72 69 67 69 6e 79 20 6e 6f 64 65 73 29 x originy nodes)
9910: 0a 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 73 69 . ;; (print "si
9920: 7a 65 78 3a 20 22 20 73 69 7a 65 78 20 22 20 73 zex: " sizex " s
9930: 69 7a 65 79 3a 20 22 20 73 69 7a 65 79 20 22 20 izey: " sizey "
9940: 6f 72 69 67 69 6e 78 3a 20 22 20 6f 72 69 67 69 originx: " origi
9950: 6e 78 20 22 20 6f 72 69 67 69 6e 79 3a 20 22 20 nx " originy: "
9960: 6f 72 69 67 69 6e 79 20 22 20 6e 6f 64 65 73 3a originy " nodes:
9970: 20 22 20 6e 6f 64 65 73 29 0a 20 20 28 6c 65 74 " nodes). (let
9980: 2a 20 28 28 6d 61 78 78 20 31 29 0a 09 20 28 6d * ((maxx 1).. (m
9990: 61 78 79 20 31 29 29 0a 20 20 20 20 28 66 6f 72 axy 1)). (for
99a0: 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 -each. (lamb
99b0: 64 61 20 28 6e 6f 64 65 29 0a 20 20 20 20 20 20 da (node).
99c0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 63 61 (if (equal? (ca
99d0: 72 20 6e 6f 64 65 29 20 22 6e 6f 64 65 22 29 0a r node) "node").
99e0: 09 20 20 20 28 6c 65 74 20 28 28 78 20 28 73 74 . (let ((x (st
99f0: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6c 69 ring->number (li
9a00: 73 74 2d 72 65 66 20 6e 6f 64 65 20 32 29 29 29 st-ref node 2)))
9a10: 0a 09 09 20 28 79 20 28 73 74 72 69 6e 67 2d 3e ... (y (string->
9a20: 6e 75 6d 62 65 72 20 28 6c 69 73 74 2d 72 65 66 number (list-ref
9a30: 20 6e 6f 64 65 20 33 29 29 29 29 0a 09 20 20 20 node 3))))..
9a40: 20 20 28 69 66 20 28 61 6e 64 20 78 20 28 3e 20 (if (and x (>
9a50: 78 20 6d 61 78 78 29 29 28 73 65 74 21 20 6d 61 x maxx))(set! ma
9a60: 78 78 20 78 29 29 0a 09 20 20 20 20 20 28 69 66 xx x)).. (if
9a70: 20 28 61 6e 64 20 79 20 28 3e 20 79 20 6d 61 78 (and y (> y max
9a80: 79 29 29 28 73 65 74 21 20 6d 61 78 79 20 79 29 y))(set! maxy y)
9a90: 29 29 29 29 0a 20 20 20 20 20 6e 6f 64 65 73 29 )))). nodes)
9aa0: 0a 20 20 20 20 28 6c 65 74 20 28 28 73 63 61 6c . (let ((scal
9ab0: 65 78 20 28 2f 20 73 69 7a 65 78 20 6d 61 78 78 ex (/ sizex maxx
9ac0: 29 29 0a 09 20 20 28 73 63 61 6c 65 79 20 28 2f )).. (scaley (/
9ad0: 20 73 69 7a 65 79 20 6d 61 78 79 29 29 29 0a 20 sizey maxy))).
9ae0: 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 ;; (print "
9af0: 6d 61 78 78 3a 20 22 20 6d 61 78 78 20 22 20 6d maxx: " maxx " m
9b00: 61 78 79 3a 20 22 20 6d 61 78 79 20 22 20 73 63 axy: " maxy " sc
9b10: 61 6c 65 78 3a 20 22 20 73 63 61 6c 65 78 20 22 alex: " scalex "
9b20: 20 73 63 61 6c 65 79 3a 20 22 20 73 63 61 6c 65 scaley: " scale
9b30: 79 29 0a 20 20 20 20 20 20 28 6d 69 6e 20 73 63 y). (min sc
9b40: 61 6c 65 78 20 73 63 61 6c 65 79 29 29 29 29 0a alex scaley)))).
9b50: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f .(define (dcommo
9b60: 6e 3a 67 65 74 2d 78 6f 66 66 73 65 74 20 74 65 n:get-xoffset te
9b70: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 73 sts-draw-state s
9b80: 69 7a 65 78 2d 69 6e 20 78 61 64 6a 2d 69 6e 29 izex-in xadj-in)
9b90: 0a 20 20 28 6c 65 74 20 28 28 78 61 64 6a 20 20 . (let ((xadj
9ba0: 28 6f 72 20 78 61 64 6a 2d 69 6e 20 20 28 68 61 (or xadj-in (ha
9bb0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
9bc0: 61 75 6c 74 20 74 65 73 74 73 2d 64 72 61 77 2d ault tests-draw-
9bd0: 73 74 61 74 65 20 27 78 61 64 6a 20 30 29 29 29 state 'xadj 0)))
9be0: 0a 09 28 73 69 7a 65 78 20 28 6f 72 20 73 69 7a ..(sizex (or siz
9bf0: 65 78 2d 69 6e 20 28 68 61 73 68 2d 74 61 62 6c ex-in (hash-tabl
9c00: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 e-ref/default te
9c10: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 sts-draw-state '
9c20: 73 69 7a 65 78 20 35 30 30 29 29 29 29 0a 20 20 sizex 500)))).
9c30: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
9c40: 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 t! tests-draw-st
9c50: 61 74 65 20 27 78 61 64 6a 20 78 61 64 6a 29 20 ate 'xadj xadj)
9c60: 3b 3b 20 66 6f 72 20 75 73 65 20 69 6e 20 64 65 ;; for use in de
9c70: 2d 73 63 61 6c 69 6e 67 20 77 68 65 6e 20 68 61 -scaling when ha
9c80: 6e 64 6c 69 6e 67 20 6d 6f 75 73 65 20 63 6c 69 ndling mouse cli
9c90: 63 6b 73 0a 20 20 20 20 28 68 61 73 68 2d 74 61 cks. (hash-ta
9ca0: 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 2d 64 ble-set! tests-d
9cb0: 72 61 77 2d 73 74 61 74 65 20 27 73 69 7a 65 78 raw-state 'sizex
9cc0: 20 73 69 7a 65 78 29 0a 20 20 20 20 28 2a 20 28 sizex). (* (
9cd0: 2f 20 73 69 7a 65 78 20 32 29 20 28 2d 20 30 2e / sizex 2) (- 0.
9ce0: 35 20 78 61 64 6a 29 29 29 29 0a 0a 28 64 65 66 5 xadj))))..(def
9cf0: 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 ine (dcommon:get
9d00: 2d 79 6f 66 66 73 65 74 20 74 65 73 74 73 2d 64 -yoffset tests-d
9d10: 72 61 77 2d 73 74 61 74 65 20 73 69 7a 65 79 2d raw-state sizey-
9d20: 69 6e 20 79 61 64 6a 2d 69 6e 29 0a 20 20 28 6c in yadj-in). (l
9d30: 65 74 20 28 28 79 61 64 6a 20 20 28 6f 72 20 79 et ((yadj (or y
9d40: 61 64 6a 2d 69 6e 20 20 28 68 61 73 68 2d 74 61 adj-in (hash-ta
9d50: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
9d60: 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 tests-draw-state
9d70: 20 27 79 61 64 6a 20 30 29 29 29 0a 09 28 73 69 'yadj 0)))..(si
9d80: 7a 65 79 20 28 6f 72 20 73 69 7a 65 79 2d 69 6e zey (or sizey-in
9d90: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
9da0: 2f 64 65 66 61 75 6c 74 20 74 65 73 74 73 2d 64 /default tests-d
9db0: 72 61 77 2d 73 74 61 74 65 20 27 73 69 7a 65 79 raw-state 'sizey
9dc0: 20 35 30 30 29 29 29 29 0a 20 20 20 20 28 68 61 500)))). (ha
9dd0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 sh-table-set! te
9de0: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 sts-draw-state '
9df0: 79 61 64 6a 20 79 61 64 6a 29 20 3b 3b 20 66 6f yadj yadj) ;; fo
9e00: 72 20 75 73 65 20 69 6e 20 64 65 2d 73 63 61 6c r use in de-scal
9e10: 69 6e 67 20 77 68 65 6e 20 68 61 6e 64 6c 69 6e ing when handlin
9e20: 67 20 6d 6f 75 73 65 20 63 6c 69 63 6b 73 0a 20 g mouse clicks.
9e30: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
9e40: 65 74 21 20 74 65 73 74 73 2d 64 72 61 77 2d 73 et! tests-draw-s
9e50: 74 61 74 65 20 27 73 69 7a 65 79 20 73 69 7a 65 tate 'sizey size
9e60: 79 29 0a 20 20 20 20 28 2a 20 28 2f 20 73 69 7a y). (* (/ siz
9e70: 65 79 20 32 29 20 28 2d 20 79 61 64 6a 20 30 2e ey 2) (- yadj 0.
9e80: 35 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 5))))..(define (
9e90: 64 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 dcommon:x->canva
9ea0: 73 20 78 20 73 63 61 6c 65 66 20 78 6f 66 66 73 s x scalef xoffs
9eb0: 65 74 29 0a 20 20 28 2b 20 78 6f 66 66 73 65 74 et). (+ xoffset
9ec0: 20 28 2a 20 78 20 73 63 61 6c 65 66 29 29 29 0a (* x scalef))).
9ed0: 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f .(define (dcommo
9ee0: 6e 3a 79 2d 3e 63 61 6e 76 61 73 20 79 20 73 63 n:y->canvas y sc
9ef0: 61 6c 65 66 20 79 6f 66 66 73 65 74 29 0a 20 20 alef yoffset).
9f00: 28 2b 20 79 6f 66 66 73 65 74 20 28 2a 20 79 20 (+ yoffset (* y
9f10: 73 63 61 6c 65 66 29 29 29 0a 0a 3b 3b 20 73 69 scalef)))..;; si
9f20: 7a 65 78 2c 20 73 69 7a 65 79 20 20 20 20 20 2d zex, sizey -
9f30: 20 63 61 6e 76 61 73 20 73 69 7a 65 0a 3b 3b 20 canvas size.;;
9f40: 6f 72 69 67 69 6e 78 2c 20 6f 72 69 67 69 6e 79 originx, originy
9f50: 20 2d 20 63 61 6e 76 61 73 20 6f 72 69 67 69 6e - canvas origin
9f60: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 63 6f .;;.(define (dco
9f70: 6d 6d 6f 6e 3a 69 6e 69 74 69 61 6c 2d 64 72 61 mmon:initial-dra
9f80: 77 2d 74 65 73 74 73 20 63 6e 76 20 78 61 64 6a w-tests cnv xadj
9f90: 20 79 61 64 6a 20 73 69 7a 65 78 20 73 69 7a 65 yadj sizex size
9fa0: 79 20 73 69 7a 65 78 6d 6d 20 73 69 7a 65 79 6d y sizexmm sizeym
9fb0: 6d 20 6f 72 69 67 69 6e 78 20 6f 72 69 67 69 6e m originx origin
9fc0: 79 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 y tests-draw-sta
9fd0: 74 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 te sorted-testna
9fe0: 6d 65 73 20 74 65 73 74 2d 72 65 63 6f 72 64 73 mes test-records
9ff0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 6f 74 2d ). (let* ((dot-
a000: 64 61 74 61 20 3b 3b 20 28 6d 61 70 20 63 64 72 data ;; (map cdr
a010: 20 28 66 69 6c 74 65 72 0a 09 09 20 20 20 3b 3b (filter... ;;
a020: 20 09 20 20 28 6c 61 6d 62 64 61 20 28 78 29 28 . (lambda (x)(
a030: 65 71 75 61 6c 3f 20 22 6e 6f 64 65 22 20 28 63 equal? "node" (c
a040: 61 72 20 78 29 29 29 0a 09 20 20 28 6d 61 70 20 ar x))).. (map
a050: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 74 65 string-split (te
a060: 73 74 73 3a 6c 61 7a 79 2d 64 6f 74 20 74 65 73 sts:lazy-dot tes
a070: 74 2d 72 65 63 6f 72 64 73 20 22 70 6c 61 69 6e t-records "plain
a080: 22 20 73 69 7a 65 78 20 73 69 7a 65 79 29 29 29 " sizex sizey)))
a090: 20 3b 3b 20 28 74 65 73 74 73 3a 65 61 73 79 2d ;; (tests:easy-
a0a0: 64 6f 74 20 74 65 73 74 2d 72 65 63 6f 72 64 73 dot test-records
a0b0: 20 22 70 6c 61 69 6e 22 29 29 29 0a 09 20 28 78 "plain"))).. (x
a0c0: 6f 66 66 73 65 74 09 20 28 64 63 6f 6d 6d 6f 6e offset. (dcommon
a0d0: 3a 67 65 74 2d 78 6f 66 66 73 65 74 20 74 65 73 :get-xoffset tes
a0e0: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 73 69 ts-draw-state si
a0f0: 7a 65 78 20 78 61 64 6a 29 29 0a 09 20 28 79 6f zex xadj)).. (yo
a100: 66 66 73 65 74 20 20 20 20 20 20 20 20 28 64 63 ffset (dc
a110: 6f 6d 6d 6f 6e 3a 67 65 74 2d 79 6f 66 66 73 65 ommon:get-yoffse
a120: 74 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 t tests-draw-sta
a130: 74 65 20 73 69 7a 65 79 20 79 61 64 6a 29 29 0a te sizey yadj)).
a140: 09 20 28 6e 6f 2d 64 6f 74 20 20 20 20 20 20 20 . (no-dot
a150: 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 (configf:looku
a160: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 p *configdat* "s
a170: 65 74 75 70 22 20 22 6e 6f 64 6f 74 22 29 29 0a etup" "nodot")).
a180: 09 20 28 62 6f 78 68 20 20 20 20 20 20 20 20 20 . (boxh
a190: 20 20 31 35 29 0a 09 20 28 62 6f 78 77 20 20 20 15).. (boxw
a1a0: 20 20 20 20 20 20 20 20 31 30 29 0a 09 20 28 6d 10).. (m
a1b0: 61 72 67 69 6e 20 20 20 20 20 20 20 20 20 35 29 argin 5)
a1c0: 0a 09 20 28 74 65 73 74 73 2d 69 6e 66 6f 20 20 .. (tests-info
a1d0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
a1e0: 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 ef tests-draw-st
a1f0: 61 74 65 20 27 74 65 73 74 73 2d 69 6e 66 6f 29 ate 'tests-info)
a200: 29 0a 09 20 28 73 65 6c 65 63 74 65 64 2d 74 65 ).. (selected-te
a210: 73 74 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d sts (hash-table-
a220: 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 ref tests-draw-s
a230: 74 61 74 65 20 27 73 65 6c 65 63 74 65 64 2d 74 tate 'selected-t
a240: 65 73 74 73 20 29 29 0a 09 20 28 73 63 61 6c 65 ests )).. (scale
a250: 66 20 20 20 20 20 20 20 20 20 28 69 66 20 6e 6f f (if no
a260: 2d 64 6f 74 0a 09 09 09 20 20 20 20 20 31 0a 09 -dot.... 1..
a270: 09 09 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a .. (dcommon:
a280: 65 73 74 69 6d 61 74 65 2d 73 63 61 6c 65 20 73 estimate-scale s
a290: 69 7a 65 78 20 73 69 7a 65 79 20 6f 72 69 67 69 izex sizey origi
a2a0: 6e 78 20 6f 72 69 67 69 6e 79 20 64 6f 74 2d 64 nx originy dot-d
a2b0: 61 74 61 29 29 29 0a 09 20 28 73 6f 72 74 65 64 ata))).. (sorted
a2c0: 2d 74 65 73 74 6e 61 6d 65 73 20 28 69 66 20 6e -testnames (if n
a2d0: 6f 2d 64 6f 74 0a 09 09 09 20 20 20 20 20 20 20 o-dot....
a2e0: 28 73 6f 72 74 20 73 6f 72 74 65 64 2d 74 65 73 (sort sorted-tes
a2f0: 74 6e 61 6d 65 73 20 73 74 72 69 6e 67 3e 3d 3f tnames string>=?
a300: 29 0a 09 09 09 20 20 20 20 20 20 20 73 6f 72 74 ).... sort
a310: 65 64 2d 74 65 73 74 6e 61 6d 65 73 29 29 0a 09 ed-testnames))..
a320: 20 28 63 75 72 72 2d 78 20 20 20 20 20 20 20 20 (curr-x
a330: 20 30 29 20 20 3b 3b 20 4e 42 2f 2f 20 4e 4f 54 0) ;; NB// NOT
a340: 20 73 63 72 65 65 6e 20 75 6e 69 74 73 0a 09 20 screen units..
a350: 28 63 75 72 72 2d 79 20 20 20 20 20 20 20 20 20 (curr-y
a360: 28 2f 20 28 2d 20 73 69 7a 65 79 20 62 6f 78 68 (/ (- sizey boxh
a370: 20 6d 61 72 67 69 6e 29 20 73 63 61 6c 65 66 29 margin) scalef)
a380: 29 20 3b 3b 20 75 73 65 64 20 77 68 65 6e 20 6e ) ;; used when n
a390: 6f 2d 64 6f 74 0a 09 20 28 73 63 61 6c 65 64 2d o-dot.. (scaled-
a3a0: 73 69 7a 65 78 20 20 20 28 2f 20 73 69 7a 65 78 sizex (/ sizex
a3b0: 20 73 63 61 6c 65 66 29 29 29 0a 0a 20 20 20 20 scalef)))..
a3c0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
a3d0: 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 tests-draw-stat
a3e0: 65 20 27 73 63 61 6c 65 66 20 73 63 61 6c 65 66 e 'scalef scalef
a3f0: 29 0a 20 20 20 20 0a 20 20 20 20 28 6c 65 74 20 ). . (let
a400: 28 28 6c 6f 6e 67 65 73 74 2d 73 74 72 20 20 20 ((longest-str
a410: 28 69 66 20 28 6e 75 6c 6c 3f 20 73 6f 72 74 65 (if (null? sorte
a420: 64 2d 74 65 73 74 6e 61 6d 65 73 29 20 22 20 20 d-testnames) "
a430: 20 20 20 20 20 20 20 22 20 28 63 61 72 20 28 73 " (car (s
a440: 6f 72 74 20 73 6f 72 74 65 64 2d 74 65 73 74 6e ort sorted-testn
a450: 61 6d 65 73 20 28 6c 61 6d 62 64 61 20 28 61 20 ames (lambda (a
a460: 62 29 28 3e 3d 20 28 73 74 72 69 6e 67 2d 6c 65 b)(>= (string-le
a470: 6e 67 74 68 20 61 29 28 73 74 72 69 6e 67 2d 6c ngth a)(string-l
a480: 65 6e 67 74 68 20 62 29 29 29 29 29 29 29 29 0a ength b)))))))).
a490: 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 (let-value
a4a0: 73 20 28 28 28 78 2d 6d 61 78 20 79 2d 6d 61 78 s (((x-max y-max
a4b0: 29 20 28 63 61 6e 76 61 73 2d 74 65 78 74 2d 73 ) (canvas-text-s
a4c0: 69 7a 65 20 63 6e 76 20 6c 6f 6e 67 65 73 74 2d ize cnv longest-
a4d0: 73 74 72 29 29 29 0a 09 28 69 66 20 28 3e 20 78 str)))..(if (> x
a4e0: 2d 6d 61 78 20 62 6f 78 77 29 28 73 65 74 21 20 -max boxw)(set!
a4f0: 62 6f 78 77 20 28 2b 20 31 30 20 78 2d 6d 61 78 boxw (+ 10 x-max
a500: 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 70 72 ))))). ;; (pr
a510: 69 6e 74 20 22 73 69 7a 65 78 3a 20 22 20 73 69 int "sizex: " si
a520: 7a 65 78 20 22 20 73 69 7a 65 79 3a 20 22 20 73 zex " sizey: " s
a530: 69 7a 65 79 20 22 20 66 6f 6e 74 3a 20 22 20 28 izey " font: " (
a540: 63 61 6e 76 61 73 2d 66 6f 6e 74 20 63 6e 76 29 canvas-font cnv)
a550: 20 22 20 6f 72 69 67 69 6e 78 3a 20 22 20 6f 72 " originx: " or
a560: 69 67 69 6e 78 20 22 20 6f 72 69 67 69 6e 79 3a iginx " originy:
a570: 20 22 20 6f 72 69 67 69 6e 79 20 22 20 78 74 6f " originy " xto
a580: 72 69 67 3a 20 22 20 78 74 6f 72 69 67 20 22 20 rig: " xtorig "
a590: 79 74 6f 72 69 67 3a 20 22 20 79 74 6f 72 69 67 ytorig: " ytorig
a5a0: 20 22 20 78 61 64 6a 3a 20 22 20 78 61 64 6a 20 " xadj: " xadj
a5b0: 22 20 79 61 64 6a 3a 20 22 20 79 61 64 6a 29 0a " yadj: " yadj).
a5c0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 (if (not (nu
a5d0: 6c 6c 3f 20 73 6f 72 74 65 64 2d 74 65 73 74 6e ll? sorted-testn
a5e0: 61 6d 65 73 29 29 0a 09 28 6c 65 74 20 6c 6f 6f ames))..(let loo
a5f0: 70 20 28 28 68 65 64 20 28 63 61 72 20 28 72 65 p ((hed (car (re
a600: 76 65 72 73 65 20 73 6f 72 74 65 64 2d 74 65 73 verse sorted-tes
a610: 74 6e 61 6d 65 73 29 29 29 0a 09 09 20 20 20 28 tnames)))... (
a620: 74 61 6c 20 28 63 64 72 20 28 72 65 76 65 72 73 tal (cdr (revers
a630: 65 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d e sorted-testnam
a640: 65 73 29 29 29 29 0a 09 20 20 28 6c 65 74 2a 20 es)))).. (let*
a650: 28 28 6e 6f 64 65 64 61 74 20 28 69 66 20 6e 6f ((nodedat (if no
a660: 2d 64 6f 74 0a 09 09 09 20 20 20 20 20 20 23 66 -dot.... #f
a670: 0a 09 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 .... (let (
a680: 28 74 6d 70 72 65 73 20 28 66 69 6c 74 65 72 20 (tmpres (filter
a690: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 (lambda (x).....
a6a0: 09 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 .. (if (and
a6b0: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 78 29 29 (not (null? x))
a6c0: 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
a6d0: 65 71 75 61 6c 3f 20 28 63 61 72 20 78 29 20 22 equal? (car x) "
a6e0: 6e 6f 64 65 22 29 29 0a 09 09 09 09 09 09 09 20 node"))........
a6f0: 20 28 65 71 75 61 6c 3f 20 68 65 64 20 28 63 61 (equal? hed (ca
a700: 64 72 20 78 29 29 0a 09 09 09 09 09 09 09 20 20 dr x))........
a710: 23 66 29 29 0a 09 09 09 09 09 09 20 20 20 20 64 #f))....... d
a720: 6f 74 2d 64 61 74 61 29 29 29 0a 09 09 09 09 28 ot-data))).....(
a730: 69 66 20 28 6e 75 6c 6c 3f 20 74 6d 70 72 65 73 if (null? tmpres
a740: 29 0a 09 09 09 09 20 20 20 20 3b 3b 20 20 20 20 )..... ;;
a750: 20 20 20 20 20 20 20 6c 6c 78 20 20 6c 6c 79 20 llx lly
a760: 62 6f 78 77 20 62 6f 78 68 0a 09 09 09 09 20 20 boxw boxh.....
a770: 20 20 28 6c 69 73 74 20 22 30 22 20 22 31 22 20 (list "0" "1"
a780: 22 31 22 20 28 63 6f 6e 63 20 28 6c 65 6e 67 74 "1" (conc (lengt
a790: 68 20 74 61 6c 29 29 20 22 32 22 20 22 30 2e 35 h tal)) "2" "0.5
a7a0: 22 29 20 3b 3b 20 72 65 74 75 72 6e 20 73 6f 6d ") ;; return som
a7b0: 65 20 70 6c 61 63 65 68 6f 6c 64 65 72 20 6a 75 e placeholder ju
a7c0: 6e 6b 20 69 66 20 6e 6f 20 64 61 74 20 66 6f 75 nk if no dat fou
a7d0: 6e 64 0a 09 09 09 09 20 20 20 20 28 63 61 72 20 nd..... (car
a7e0: 74 6d 70 72 65 73 29 29 29 29 29 0a 09 09 20 28 tmpres)))))... (
a7f0: 65 64 67 65 64 61 74 20 28 69 66 20 6e 6f 2d 64 edgedat (if no-d
a800: 6f 74 0a 09 09 09 20 20 20 20 20 20 27 28 29 0a ot.... '().
a810: 09 09 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 ... (let ((
a820: 65 64 67 65 73 20 28 66 69 6c 74 65 72 20 28 6c edges (filter (l
a830: 61 6d 62 64 61 20 28 78 29 20 20 3b 3b 20 66 69 ambda (x) ;; fi
a840: 6c 74 65 72 20 66 6f 72 20 65 64 67 65 0a 09 09 lter for edge...
a850: 09 09 09 09 20 20 20 20 20 28 69 66 20 28 61 6e .... (if (an
a860: 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 78 29 d (not (null? x)
a870: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 28 )........ (
a880: 65 71 75 61 6c 3f 20 28 63 61 72 20 78 29 20 22 equal? (car x) "
a890: 65 64 67 65 22 29 29 0a 09 09 09 09 09 09 09 20 edge"))........
a8a0: 28 65 71 75 61 6c 3f 20 68 65 64 20 28 63 61 64 (equal? hed (cad
a8b0: 72 20 78 29 29 0a 09 09 09 09 09 09 09 20 23 66 r x))........ #f
a8c0: 29 29 0a 09 09 09 09 09 09 20 20 20 64 6f 74 2d ))....... dot-
a8d0: 64 61 74 61 29 29 29 0a 09 09 09 09 28 6d 61 70 data))).....(map
a8e0: 20 28 6c 61 6d 62 64 61 20 28 69 6e 6c 73 74 29 (lambda (inlst)
a8f0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 64 63 6f ..... (dco
a900: 6d 6d 6f 6e 3a 70 72 6f 63 65 73 73 2d 70 6f 6c mmon:process-pol
a910: 79 6c 69 6e 65 20 0a 09 09 09 09 09 28 6d 61 70 yline ......(map
a920: 20 28 6c 61 6d 62 64 61 20 28 69 6e 73 74 72 29 (lambda (instr)
a930: 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 73 74 ...... (st
a940: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 69 6e 73 ring->number ins
a950: 74 72 29 29 20 3b 3b 20 63 6f 6e 76 65 72 74 20 tr)) ;; convert
a960: 74 6f 20 6e 75 6d 62 65 72 20 61 6e 64 20 73 63 to number and sc
a970: 61 6c 65 0a 09 09 09 09 09 20 20 20 20 20 28 6c ale...... (l
a980: 65 74 20 28 28 69 6c 20 28 63 64 64 64 64 72 20 et ((il (cddddr
a990: 69 6e 6c 73 74 29 29 29 0a 09 09 09 09 09 20 20 inlst)))......
a9a0: 20 20 20 20 20 28 74 61 6b 65 20 69 6c 20 28 2d (take il (-
a9b0: 20 28 6c 65 6e 67 74 68 20 69 6c 29 20 32 29 29 (length il) 2))
a9c0: 29 29 0a 09 09 09 09 09 28 6c 61 6d 62 64 61 20 ))......(lambda
a9d0: 28 78 20 79 29 0a 09 09 09 09 09 20 20 28 6c 69 (x y)...... (li
a9e0: 73 74 20 28 2b 20 78 20 30 29 20 20 20 3b 3b 20 st (+ x 0) ;;
a9f0: 78 74 6f 72 69 67 29 0a 09 09 09 09 09 09 28 2b xtorig).......(+
aa00: 20 79 20 30 29 29 29 20 3b 3b 20 79 74 6f 72 69 y 0))) ;; ytori
aa10: 67 29 29 29 0a 09 09 09 09 09 23 66 20 23 66 29 g)))......#f #f)
aa20: 29 20 3b 3b 20 70 72 6f 63 65 73 73 20 70 6f 6c ) ;; process pol
aa30: 79 6c 69 6e 65 0a 09 09 09 09 20 20 20 20 20 65 yline..... e
aa40: 64 67 65 73 29 29 29 29 0a 09 09 20 28 63 78 20 dges))))... (cx
aa50: 20 20 28 69 66 20 6e 6f 2d 64 6f 74 20 3b 3b 20 (if no-dot ;;
aa60: 74 68 69 73 20 69 73 20 74 68 65 20 63 65 6e 74 this is the cent
aa70: 65 72 70 6f 69 6e 74 21 0a 09 09 09 20 20 20 63 erpoint!.... c
aa80: 75 72 72 2d 78 0a 09 09 09 20 20 20 28 73 74 72 urr-x.... (str
aa90: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6c 69 73 ing->number (lis
aaa0: 74 2d 72 65 66 20 6e 6f 64 65 64 61 74 20 32 29 t-ref nodedat 2)
aab0: 29 29 29 0a 09 09 20 28 63 79 20 20 20 28 69 66 )))... (cy (if
aac0: 20 6e 6f 2d 64 6f 74 0a 09 09 09 20 20 20 63 75 no-dot.... cu
aad0: 72 72 2d 79 0a 09 09 09 20 20 20 28 73 74 72 69 rr-y.... (stri
aae0: 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6c 69 73 74 ng->number (list
aaf0: 2d 72 65 66 20 6e 6f 64 65 64 61 74 20 33 29 29 -ref nodedat 3))
ab00: 29 29 0a 09 09 20 28 62 6f 78 77 20 28 69 66 20 ))... (boxw (if
ab10: 6e 6f 2d 64 6f 74 0a 09 09 09 20 20 20 62 6f 78 no-dot.... box
ab20: 77 0a 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d w.... (string-
ab30: 3e 6e 75 6d 62 65 72 20 28 6c 69 73 74 2d 72 65 >number (list-re
ab40: 66 20 6e 6f 64 65 64 61 74 20 34 29 29 29 29 0a f nodedat 4)))).
ab50: 09 09 20 28 62 6f 78 68 20 28 69 66 20 6e 6f 2d .. (boxh (if no-
ab60: 64 6f 74 0a 09 09 09 20 20 20 62 6f 78 68 0a 09 dot.... boxh..
ab70: 09 09 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 .. (string->nu
ab80: 6d 62 65 72 20 28 6c 69 73 74 2d 72 65 66 20 6e mber (list-ref n
ab90: 6f 64 65 64 61 74 20 35 29 29 29 29 0a 09 09 20 odedat 5))))...
aba0: 28 62 6f 78 77 2f 32 20 20 28 2f 20 62 6f 78 77 (boxw/2 (/ boxw
abb0: 20 32 29 29 0a 09 09 20 28 62 6f 78 68 2f 32 20 2))... (boxh/2
abc0: 20 28 2f 20 62 6f 78 68 20 32 29 29 0a 09 09 20 (/ boxh 2))...
abd0: 28 75 72 78 20 20 20 20 20 28 2b 20 63 78 20 62 (urx (+ cx b
abe0: 6f 78 77 2f 32 29 29 0a 09 09 20 28 75 72 79 20 oxw/2))... (ury
abf0: 20 20 20 20 28 2b 20 63 79 20 62 6f 78 68 2f 32 (+ cy boxh/2
ac00: 29 29 0a 09 09 20 28 6c 6c 78 20 20 20 20 20 28 ))... (llx (
ac10: 2d 20 63 78 20 62 6f 78 77 2f 32 29 29 0a 09 09 - cx boxw/2))...
ac20: 20 28 6c 6c 79 20 20 20 20 20 28 2d 20 63 79 20 (lly (- cy
ac30: 62 6f 78 68 2f 32 29 29 29 0a 0a 09 20 20 20 20 boxh/2)))...
ac40: 3b 3b 20 69 66 20 77 65 20 61 72 65 20 69 6e 20 ;; if we are in
ac50: 6e 6f 2d 64 6f 74 20 6d 6f 64 65 20 74 68 65 6e no-dot mode then
ac60: 20 69 6e 63 72 65 6d 65 6e 74 20 63 75 72 72 2d increment curr-
ac70: 78 20 61 6e 64 20 63 75 72 72 2d 79 20 61 73 20 x and curr-y as
ac80: 6e 65 65 64 65 64 0a 09 20 20 20 20 28 69 66 20 needed.. (if
ac90: 6e 6f 2d 64 6f 74 0a 09 09 28 62 65 67 69 6e 0a no-dot...(begin.
aca0: 09 09 20 20 28 63 6f 6e 64 20 0a 09 09 20 20 20 .. (cond ...
acb0: 28 28 3c 20 63 75 72 72 2d 78 20 28 2d 20 73 63 ((< curr-x (- sc
acc0: 61 6c 65 64 2d 73 69 7a 65 78 20 62 6f 78 77 20 aled-sizex boxw
acd0: 62 6f 78 77 20 6d 61 72 67 69 6e 29 29 0a 09 09 boxw margin))...
ace0: 20 20 20 20 28 73 65 74 21 20 63 75 72 72 2d 78 (set! curr-x
acf0: 20 28 2b 20 63 75 72 72 2d 78 20 62 6f 78 77 20 (+ curr-x boxw
ad00: 6d 61 72 67 69 6e 29 29 29 0a 09 09 20 20 20 28 margin)))... (
ad10: 28 3e 20 63 75 72 72 2d 78 20 28 2d 20 73 63 61 (> curr-x (- sca
ad20: 6c 65 64 2d 73 69 7a 65 78 20 62 6f 78 77 20 62 led-sizex boxw b
ad30: 6f 78 77 20 6d 61 72 67 69 6e 29 29 0a 09 09 20 oxw margin))...
ad40: 20 20 20 28 73 65 74 21 20 63 75 72 72 2d 78 20 (set! curr-x
ad50: 30 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 63 0)... (set! c
ad60: 75 72 72 2d 79 20 28 2d 20 63 75 72 72 2d 79 20 urr-y (- curr-y
ad70: 28 2b 20 62 6f 78 68 20 6d 61 72 67 69 6e 29 29 (+ boxh margin))
ad80: 29 29 29 29 29 0a 09 09 09 09 09 3b 20 28 70 72 )))))......; (pr
ad90: 69 6e 74 20 22 68 65 64 20 22 20 68 65 64 20 22 int "hed " hed "
ada0: 20 6c 6c 78 20 22 20 6c 6c 78 20 22 20 6c 6c 79 llx " llx " lly
adb0: 20 22 20 6c 6c 79 20 22 20 75 72 78 20 22 20 75 " lly " urx " u
adc0: 72 78 20 22 20 75 72 79 20 22 20 75 72 79 29 0a rx " ury " ury).
add0: 09 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 . (dcommon:dr
ade0: 61 77 2d 74 65 73 74 20 63 6e 76 20 78 6f 66 66 aw-test cnv xoff
adf0: 73 65 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c set yoffset scal
ae00: 65 66 20 6c 6c 78 20 6c 6c 79 20 62 6f 78 77 20 ef llx lly boxw
ae10: 62 6f 78 68 20 68 65 64 20 28 68 61 73 68 2d 74 boxh hed (hash-t
ae20: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
ae30: 20 73 65 6c 65 63 74 65 64 2d 74 65 73 74 73 20 selected-tests
ae40: 68 65 64 20 23 66 29 29 0a 09 20 20 20 20 3b 3b hed #f)).. ;;
ae50: 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 61 (dcommon:draw-a
ae60: 72 72 6f 77 73 20 63 6e 76 20 74 65 73 74 6e 61 rrows cnv testna
ae70: 6d 65 20 74 65 73 74 73 2d 69 6e 66 6f 20 74 65 me tests-info te
ae80: 73 74 2d 72 65 63 6f 72 64 73 29 29 0a 09 20 20 st-records))..
ae90: 20 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 77 2d (dcommon:draw-
aea0: 65 64 67 65 73 20 63 6e 76 20 78 6f 66 66 73 65 edges cnv xoffse
aeb0: 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c 65 66 t yoffset scalef
aec0: 20 65 64 67 65 64 61 74 29 0a 09 20 20 20 20 0a edgedat).. .
aed0: 09 20 20 20 20 3b 3b 20 64 61 74 61 20 75 73 65 . ;; data use
aee0: 64 20 62 79 20 6d 6f 75 73 65 20 63 6c 69 63 6b d by mouse click
aef0: 20 63 61 6c 63 2e 20 6b 65 65 70 20 74 68 65 20 calc. keep the
af00: 77 61 63 6b 79 20 6f 72 64 65 72 20 66 6f 72 20 wacky order for
af10: 6e 6f 77 2e 0a 09 20 20 20 20 28 68 61 73 68 2d now... (hash-
af20: 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 73 table-set! tests
af30: 2d 69 6e 66 6f 20 68 65 64 20 20 28 6c 69 73 74 -info hed (list
af40: 20 6c 6c 78 20 6c 6c 79 20 75 72 78 20 75 72 79 llx lly urx ury
af50: 20 62 6f 78 77 20 62 6f 78 68 20 65 64 67 65 64 boxw boxh edged
af60: 61 74 29 29 20 0a 09 20 20 20 20 28 69 66 20 28 at)) .. (if (
af70: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 not (null? tal))
af80: 0a 09 09 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 ...(loop (car ta
af90: 6c 29 0a 09 09 20 20 20 20 20 20 28 63 64 72 20 l)... (cdr
afa0: 74 61 6c 29 29 29 29 29 29 0a 20 20 20 20 29 29 tal)))))). ))
afb0: 0a 0a 3b 3b 20 70 65 72 2d 70 6f 69 6e 74 2d 70 ..;; per-point-p
afc0: 72 6f 63 20 72 65 71 75 69 72 65 64 2c 20 72 65 roc required, re
afd0: 6d 61 69 6e 64 65 72 20 6f 70 74 69 6f 6e 61 6c mainder optional
afe0: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 63 6f .;;.(define (dco
aff0: 6d 6d 6f 6e 3a 70 72 6f 63 65 73 73 2d 70 6f 6c mmon:process-pol
b000: 79 6c 69 6e 65 20 6c 69 6e 65 20 70 65 72 2d 70 yline line per-p
b010: 6f 69 6e 74 2d 70 72 6f 63 20 70 65 72 2d 73 65 oint-proc per-se
b020: 67 6d 65 6e 74 2d 70 72 6f 63 20 6c 61 73 74 2d gment-proc last-
b030: 73 65 67 6d 65 6e 74 2d 70 72 6f 63 29 0a 20 20 segment-proc).
b040: 28 69 66 20 28 3c 20 28 6c 65 6e 67 74 68 20 6c (if (< (length l
b050: 69 6e 65 29 20 32 29 0a 20 20 20 20 20 20 27 28 ine) 2). '(
b060: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f ). (let loo
b070: 70 20 28 28 78 31 20 20 20 28 63 61 72 20 20 6c p ((x1 (car l
b080: 69 6e 65 29 29 0a 09 09 20 28 79 31 20 20 20 28 ine))... (y1 (
b090: 63 61 64 72 20 6c 69 6e 65 29 29 0a 09 09 20 28 cadr line))... (
b0a0: 78 32 20 20 20 23 66 29 0a 09 09 20 28 79 32 20 x2 #f)... (y2
b0b0: 20 20 23 66 29 0a 09 09 20 28 74 61 6c 20 20 28 #f)... (tal (
b0c0: 63 64 64 72 20 6c 69 6e 65 29 29 0a 09 09 20 28 cddr line))... (
b0d0: 72 65 73 20 20 27 28 29 29 29 0a 09 28 69 66 20 res '()))..(if
b0e0: 28 61 6e 64 20 78 31 20 79 31 20 78 32 20 79 32 (and x1 y1 x2 y2
b0f0: 20 70 65 72 2d 73 65 67 6d 65 6e 74 2d 70 72 6f per-segment-pro
b100: 63 29 0a 09 20 20 20 20 28 70 65 72 2d 73 65 67 c).. (per-seg
b110: 6d 65 6e 74 2d 70 72 6f 63 20 78 31 20 79 31 20 ment-proc x1 y1
b120: 78 32 20 79 32 29 29 0a 09 28 69 66 20 28 3c 20 x2 y2))..(if (<
b130: 28 6c 65 6e 67 74 68 20 74 61 6c 29 20 32 29 0a (length tal) 2).
b140: 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 . (begin..
b150: 20 20 20 28 69 66 20 6c 61 73 74 2d 73 65 67 6d (if last-segm
b160: 65 6e 74 2d 70 72 6f 63 20 28 6c 61 73 74 2d 73 ent-proc (last-s
b170: 65 67 6d 65 6e 74 2d 70 72 6f 63 20 78 31 20 79 egment-proc x1 y
b180: 31 20 78 32 20 79 32 29 29 0a 09 20 20 20 20 20 1 x2 y2))..
b190: 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 70 65 (append res (pe
b1a0: 72 2d 70 6f 69 6e 74 2d 70 72 6f 63 20 78 31 20 r-point-proc x1
b1b0: 79 31 29 29 29 0a 09 20 20 20 20 28 6c 6f 6f 70 y1))).. (loop
b1c0: 20 28 63 61 72 20 74 61 6c 29 28 63 61 64 72 20 (car tal)(cadr
b1d0: 74 61 6c 29 20 78 31 20 79 31 20 28 63 64 64 72 tal) x1 y1 (cddr
b1e0: 20 74 61 6c 29 20 28 61 70 70 65 6e 64 20 72 65 tal) (append re
b1f0: 73 20 28 70 65 72 2d 70 6f 69 6e 74 2d 70 72 6f s (per-point-pro
b200: 63 20 78 31 20 79 31 29 29 29 29 29 29 29 0a 0a c x1 y1)))))))..
b210: 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e (define (dcommon
b220: 3a 72 65 64 72 61 77 2d 74 65 73 74 73 20 63 6e :redraw-tests cn
b230: 76 20 78 61 64 6a 20 79 61 64 6a 20 73 69 7a 65 v xadj yadj size
b240: 78 20 73 69 7a 65 79 20 73 69 7a 65 78 6d 6d 20 x sizey sizexmm
b250: 73 69 7a 65 79 6d 6d 20 6f 72 69 67 69 6e 78 20 sizeymm originx
b260: 6f 72 69 67 69 6e 79 20 74 65 73 74 73 2d 64 72 originy tests-dr
b270: 61 77 2d 73 74 61 74 65 20 73 6f 72 74 65 64 2d aw-state sorted-
b280: 74 65 73 74 6e 61 6d 65 73 20 74 65 73 74 2d 72 testnames test-r
b290: 65 63 6f 72 64 73 29 0a 20 20 28 6c 65 74 2a 20 ecords). (let*
b2a0: 28 28 73 63 61 6c 65 66 20 20 20 20 20 20 20 20 ((scalef
b2b0: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
b2c0: 65 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 e-ref tests-draw
b2d0: 2d 73 74 61 74 65 20 27 73 63 61 6c 65 66 29 29 -state 'scalef))
b2e0: 0a 09 20 28 78 6f 66 66 73 65 74 20 20 20 20 20 .. (xoffset
b2f0: 20 20 20 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e (dcommon
b300: 3a 67 65 74 2d 78 6f 66 66 73 65 74 20 74 65 73 :get-xoffset tes
b310: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 73 69 ts-draw-state si
b320: 7a 65 78 20 78 61 64 6a 29 29 0a 09 20 28 79 6f zex xadj)).. (yo
b330: 66 66 73 65 74 20 20 20 20 20 20 20 20 20 20 20 ffset
b340: 20 20 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 79 (dcommon:get-y
b350: 6f 66 66 73 65 74 20 74 65 73 74 73 2d 64 72 61 offset tests-dra
b360: 77 2d 73 74 61 74 65 20 73 69 7a 65 79 20 79 61 w-state sizey ya
b370: 64 6a 29 29 0a 09 20 28 74 65 73 74 73 2d 69 6e dj)).. (tests-in
b380: 66 6f 20 20 20 20 20 20 20 20 20 20 28 68 61 73 fo (has
b390: 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 h-table-ref test
b3a0: 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 74 65 s-draw-state 'te
b3b0: 73 74 73 2d 69 6e 66 6f 29 29 0a 09 20 28 73 65 sts-info)).. (se
b3c0: 6c 65 63 74 65 64 2d 74 65 73 74 73 20 20 20 20 lected-tests
b3d0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
b3e0: 66 20 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 f tests-draw-sta
b3f0: 74 65 20 27 73 65 6c 65 63 74 65 64 2d 74 65 73 te 'selected-tes
b400: 74 73 20 29 29 29 0a 20 20 20 20 28 69 66 20 28 ts ))). (if (
b410: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 73 6f 72 74 65 not (null? sorte
b420: 64 2d 74 65 73 74 6e 61 6d 65 73 29 29 0a 09 28 d-testnames))..(
b430: 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 let loop ((hed (
b440: 63 61 72 20 28 72 65 76 65 72 73 65 20 73 6f 72 car (reverse sor
b450: 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 29 29 29 ted-testnames)))
b460: 0a 09 09 20 20 20 28 74 61 6c 20 28 63 64 72 20 ... (tal (cdr
b470: 28 72 65 76 65 72 73 65 20 73 6f 72 74 65 64 2d (reverse sorted-
b480: 74 65 73 74 6e 61 6d 65 73 29 29 29 29 0a 09 20 testnames))))..
b490: 20 28 6c 65 74 2a 20 28 28 74 76 61 6c 73 20 28 (let* ((tvals (
b4a0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 hash-table-ref t
b4b0: 65 73 74 73 2d 69 6e 66 6f 20 68 65 64 29 29 0a ests-info hed)).
b4c0: 09 09 20 28 6c 6c 78 20 20 20 28 6c 69 73 74 2d .. (llx (list-
b4d0: 72 65 66 20 74 76 61 6c 73 20 30 29 29 0a 09 09 ref tvals 0))...
b4e0: 20 28 6c 6c 79 20 20 20 28 6c 69 73 74 2d 72 65 (lly (list-re
b4f0: 66 20 74 76 61 6c 73 20 31 29 29 0a 09 09 20 28 f tvals 1))... (
b500: 62 6f 78 77 20 20 28 6c 69 73 74 2d 72 65 66 20 boxw (list-ref
b510: 74 76 61 6c 73 20 34 29 29 0a 09 09 20 28 62 6f tvals 4))... (bo
b520: 78 68 20 20 28 6c 69 73 74 2d 72 65 66 20 74 76 xh (list-ref tv
b530: 61 6c 73 20 35 29 29 0a 09 09 20 28 65 64 67 65 als 5))... (edge
b540: 73 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 s (map (lambda (
b550: 70 6c 69 6e 65 29 0a 09 09 09 20 20 20 20 20 20 pline)....
b560: 20 28 64 63 6f 6d 6d 6f 6e 3a 70 72 6f 63 65 73 (dcommon:proces
b570: 73 2d 70 6f 6c 79 6c 69 6e 65 20 70 6c 69 6e 65 s-polyline pline
b580: 0a 09 09 09 09 09 09 09 20 28 6c 61 6d 62 64 61 ........ (lambda
b590: 20 28 78 31 20 79 31 29 0a 09 09 09 09 09 09 09 (x1 y1)........
b5a0: 20 20 20 28 6c 69 73 74 20 78 31 20 79 31 29 29 (list x1 y1))
b5b0: 0a 09 09 09 09 09 09 09 20 23 66 20 23 66 29 29 ........ #f #f))
b5c0: 0a 09 09 09 20 20 20 20 20 28 6c 69 73 74 2d 72 .... (list-r
b5d0: 65 66 20 74 76 61 6c 73 20 36 29 29 29 0a 09 09 ef tvals 6)))...
b5e0: 20 28 75 72 78 20 20 20 28 2b 20 6c 6c 78 20 62 (urx (+ llx b
b5f0: 6f 78 77 29 29 0a 09 09 20 28 75 72 79 20 20 20 oxw))... (ury
b600: 28 2b 20 6c 6c 79 20 62 6f 78 68 29 29 29 0a 09 (+ lly boxh)))..
b610: 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a 64 72 61 (dcommon:dra
b620: 77 2d 74 65 73 74 20 63 6e 76 20 78 6f 66 66 73 w-test cnv xoffs
b630: 65 74 20 79 6f 66 66 73 65 74 20 73 63 61 6c 65 et yoffset scale
b640: 66 20 6c 6c 78 20 6c 6c 79 20 62 6f 78 77 20 62 f llx lly boxw b
b650: 6f 78 68 20 68 65 64 20 28 68 61 73 68 2d 74 61 oxh hed (hash-ta
b660: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
b670: 73 65 6c 65 63 74 65 64 2d 74 65 73 74 73 20 68 selected-tests h
b680: 65 64 20 23 66 29 29 0a 09 20 20 20 20 28 64 63 ed #f)).. (dc
b690: 6f 6d 6d 6f 6e 3a 64 72 61 77 2d 65 64 67 65 73 ommon:draw-edges
b6a0: 20 63 6e 76 20 78 6f 66 66 73 65 74 20 79 6f 66 cnv xoffset yof
b6b0: 66 73 65 74 20 73 63 61 6c 65 66 20 65 64 67 65 fset scalef edge
b6c0: 73 29 0a 09 20 20 20 20 28 69 66 20 28 6e 6f 74 s).. (if (not
b6d0: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 (null? tal))...
b6e0: 3b 3b 20 6c 65 61 76 65 20 61 20 63 6f 6c 75 6d ;; leave a colum
b6f0: 6e 20 6f 66 20 73 70 61 63 65 20 74 6f 20 74 68 n of space to th
b700: 65 20 72 69 67 68 74 20 74 6f 20 6c 69 73 74 20 e right to list
b710: 69 74 65 6d 73 0a 09 09 28 6c 6f 6f 70 20 28 63 items...(loop (c
b720: 61 72 20 74 61 6c 29 0a 09 09 20 20 20 20 20 20 ar tal)...
b730: 28 63 64 72 20 74 61 6c 29 29 29 29 29 29 29 29 (cdr tal))))))))
b740: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
b750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 55 ==========.;; RU
b790: 4e 20 43 4f 4e 54 52 4f 4c 53 0a 3b 3b 3d 3d 3d N CONTROLS.;;===
b7a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7e0: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 ===..(define (dc
b7f0: 6f 6d 6d 6f 6e 3a 63 6f 6d 6d 61 6e 64 2d 65 78 ommon:command-ex
b800: 65 63 75 74 69 6f 6e 2d 63 6f 6e 74 72 6f 6c 20 ecution-control
b810: 64 61 74 61 29 0a 20 20 3b 3b 20 54 68 65 20 63 data). ;; The c
b820: 6f 6d 6d 61 6e 64 20 6c 69 6e 65 20 64 69 73 70 ommand line disp
b830: 6c 61 79 2f 65 78 65 63 74 75 74 69 6f 6e 20 63 lay/exectution c
b840: 6f 6e 74 72 6f 6c 0a 20 20 28 69 75 70 3a 66 72 ontrol. (iup:fr
b850: 61 6d 65 0a 20 20 20 23 3a 74 69 74 6c 65 20 22 ame. #:title "
b860: 43 6f 6d 6d 61 6e 64 20 74 6f 20 62 65 20 65 78 Command to be ex
b870: 65 63 74 75 74 65 64 22 0a 20 20 20 28 69 75 70 ectuted". (iup
b880: 3a 68 62 6f 78 0a 20 20 20 20 28 69 75 70 3a 6c :hbox. (iup:l
b890: 61 62 65 6c 20 22 52 75 6e 20 6f 6e 22 20 23 3a abel "Run on" #:
b8a0: 73 69 7a 65 20 22 34 30 78 22 29 0a 20 20 20 20 size "40x").
b8b0: 28 69 75 70 3a 72 61 64 69 6f 20 0a 20 20 20 20 (iup:radio .
b8c0: 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20 20 20 (iup:hbox.
b8d0: 20 28 69 75 70 3a 74 6f 67 67 6c 65 20 22 4c 6f (iup:toggle "Lo
b8e0: 63 61 6c 22 20 23 3a 73 69 7a 65 20 22 34 30 78 cal" #:size "40x
b8f0: 22 29 0a 20 20 20 20 20 20 28 69 75 70 3a 74 6f "). (iup:to
b900: 67 67 6c 65 20 22 53 65 72 76 65 72 22 20 23 3a ggle "Server" #:
b910: 73 69 7a 65 20 22 34 30 78 22 29 29 29 0a 20 20 size "40x"))).
b920: 20 20 28 6c 65 74 20 28 28 74 62 20 28 69 75 70 (let ((tb (iup
b930: 3a 74 65 78 74 62 6f 78 20 0a 09 20 20 20 20 20 :textbox ..
b940: 20 20 23 3a 76 61 6c 75 65 20 22 6d 65 67 61 74 #:value "megat
b950: 65 73 74 20 22 0a 09 20 20 20 20 20 20 20 23 3a est ".. #:
b960: 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 expand "HORIZONT
b970: 41 4c 22 0a 09 20 20 20 20 20 20 20 23 3a 72 65 AL".. #:re
b980: 61 64 6f 6e 6c 79 20 22 59 45 53 22 0a 09 20 20 adonly "YES"..
b990: 20 20 20 20 20 23 3a 66 6f 6e 74 20 22 43 6f 75 #:font "Cou
b9a0: 72 69 65 72 20 4e 65 77 2c 20 2d 31 32 22 0a 09 rier New, -12"..
b9b0: 20 20 20 20 20 20 20 29 29 29 0a 20 20 20 20 20 ))).
b9c0: 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d (dboard:tabdat-
b9d0: 63 6f 6d 6d 61 6e 64 2d 74 62 2d 73 65 74 21 20 command-tb-set!
b9e0: 64 61 74 61 20 74 62 29 0a 20 20 20 20 20 20 74 data tb). t
b9f0: 62 29 0a 20 20 20 20 28 69 75 70 3a 62 75 74 74 b). (iup:butt
ba00: 6f 6e 20 22 45 78 65 63 75 74 65 22 20 23 3a 73 on "Execute" #:s
ba10: 69 7a 65 20 22 35 30 78 22 0a 09 09 23 3a 61 63 ize "50x"...#:ac
ba20: 74 69 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 tion (lambda (ob
ba30: 6a 29 0a 09 09 09 20 20 20 3b 3b 20 28 6c 65 74 j).... ;; (let
ba40: 20 28 28 63 6d 64 20 28 63 6f 6e 63 20 3b 3b 20 ((cmd (conc ;;
ba50: 22 78 74 65 72 6d 20 2d 67 65 6f 6d 65 74 72 79 "xterm -geometry
ba60: 20 31 38 30 78 32 30 20 2d 65 20 5c 22 22 0a 20 180x20 -e \"".
ba70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba80: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f (commo
ba90: 6e 3a 72 75 6e 2d 61 2d 63 6f 6d 6d 61 6e 64 20 n:run-a-command
baa0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 28 (iup:attribute (
bab0: 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 63 6f dboard:tabdat-co
bac0: 6d 6d 61 6e 64 2d 74 62 20 64 61 74 61 29 20 22 mmand-tb data) "
bad0: 56 41 4c 55 45 22 29 29 29 29 29 29 29 0a 20 20 VALUE"))))))).
bae0: 20 20 3b 3b 20 22 3b 65 63 68 6f 20 50 72 65 73 ;; ";echo Pres
baf0: 73 20 61 6e 79 20 6b 65 79 20 74 6f 20 63 6f 6e s any key to con
bb00: 74 69 6e 75 65 3b 62 61 73 68 20 2d 63 20 27 72 tinue;bash -c 'r
bb10: 65 61 64 20 2d 6e 20 31 20 2d 73 27 5c 22 20 26 ead -n 1 -s'\" &
bb20: 22 29 29 29 0a 20 20 20 20 3b 3b 20 28 73 79 73 "))). ;; (sys
bb30: 74 65 6d 20 63 6d 64 29 29 29 29 29 29 29 0a 0a tem cmd)))))))..
bb40: 28 64 65 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e (define (dcommon
bb50: 3a 63 6f 6d 6d 61 6e 64 2d 61 63 74 69 6f 6e 2d :command-action-
bb60: 73 65 6c 65 63 74 6f 72 20 63 6f 6d 6d 6f 6e 64 selector commond
bb70: 61 74 20 74 61 62 64 61 74 20 23 21 6b 65 79 20 at tabdat #!key
bb80: 28 74 61 62 2d 6e 75 6d 20 23 66 29 29 0a 20 20 (tab-num #f)).
bb90: 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 20 23 3a (iup:frame. #:
bba0: 74 69 74 6c 65 20 22 53 65 74 20 74 68 65 20 61 title "Set the a
bbb0: 63 74 69 6f 6e 20 74 6f 20 74 61 6b 65 22 0a 20 ction to take".
bbc0: 20 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20 20 (iup:hbox.
bbd0: 3b 3b 20 28 69 75 70 3a 6c 61 62 65 6c 20 22 43 ;; (iup:label "C
bbe0: 6f 6d 6d 61 6e 64 20 74 6f 20 72 75 6e 22 20 23 ommand to run" #
bbf0: 3a 65 78 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e :expand "HORIZON
bc00: 54 41 4c 22 20 23 3a 73 69 7a 65 20 22 37 30 78 TAL" #:size "70x
bc10: 22 20 23 3a 61 6c 69 67 6e 6d 65 6e 74 20 22 4c " #:alignment "L
bc20: 45 46 54 3a 41 43 45 4e 54 45 52 22 29 0a 20 20 EFT:ACENTER").
bc30: 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 73 2d 6c (let* ((cmds-l
bc40: 69 73 74 20 27 28 22 72 75 6e 22 20 22 72 65 6d ist '("run" "rem
bc50: 6f 76 65 2d 72 75 6e 73 22 29 29 20 3b 3b 20 20 ove-runs")) ;;
bc60: 22 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 "set-state-statu
bc70: 73 22 20 22 6c 6f 63 6b 2d 72 75 6e 73 22 20 22 s" "lock-runs" "
bc80: 75 6e 6c 6f 63 6b 2d 72 75 6e 73 22 29 29 0a 09 unlock-runs"))..
bc90: 20 20 20 28 6c 62 20 20 20 20 20 20 20 20 20 28 (lb (
bca0: 69 75 70 3a 6c 69 73 74 62 6f 78 20 23 3a 65 78 iup:listbox #:ex
bcb0: 70 61 6e 64 20 22 48 4f 52 49 5a 4f 4e 54 41 4c pand "HORIZONTAL
bcc0: 22 0a 09 09 09 09 20 20 20 20 23 3a 64 72 6f 70 "..... #:drop
bcd0: 64 6f 77 6e 20 22 59 45 53 22 0a 09 09 09 09 20 down "YES".....
bce0: 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d #:action (lam
bcf0: 62 64 61 20 28 6f 62 6a 20 76 61 6c 20 69 6e 64 bda (obj val ind
bd00: 65 78 20 6c 62 73 74 61 74 65 29 0a 09 09 09 09 ex lbstate).....
bd10: 09 20 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e . ;; (prin
bd20: 74 20 6f 62 6a 20 22 20 22 20 76 61 6c 20 22 20 t obj " " val "
bd30: 22 20 69 6e 64 65 78 20 22 20 22 20 6c 62 73 74 " index " " lbst
bd40: 61 74 65 29 0a 09 09 09 09 09 20 20 20 20 20 20 ate)......
bd50: 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d (dboard:tabdat-
bd60: 63 6f 6d 6d 61 6e 64 2d 73 65 74 21 20 74 61 62 command-set! tab
bd70: 64 61 74 20 76 61 6c 29 0a 09 09 09 09 09 20 20 dat val)......
bd80: 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a (dashboard:
bd90: 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 update-run-comma
bda0: 6e 64 20 74 61 62 64 61 74 29 29 29 29 0a 09 20 nd tabdat))))..
bdb0: 20 20 28 64 65 66 61 75 6c 74 2d 63 6d 64 20 28 (default-cmd (
bdc0: 63 61 72 20 63 6d 64 73 2d 6c 69 73 74 29 29 29 car cmds-list)))
bdd0: 0a 20 20 20 20 20 20 28 69 75 70 6c 69 73 74 62 . (iuplistb
bde0: 6f 78 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 20 ox-fill-list lb
bdf0: 63 6d 64 73 2d 6c 69 73 74 20 73 65 6c 65 63 74 cmds-list select
be00: 65 64 2d 69 74 65 6d 3a 20 64 65 66 61 75 6c 74 ed-item: default
be10: 2d 63 6d 64 29 0a 20 20 20 20 20 20 28 64 62 6f -cmd). (dbo
be20: 61 72 64 3a 74 61 62 64 61 74 2d 63 6f 6d 6d 61 ard:tabdat-comma
be30: 6e 64 2d 73 65 74 21 20 74 61 62 64 61 74 20 64 nd-set! tabdat d
be40: 65 66 61 75 6c 74 2d 63 6d 64 29 0a 20 20 20 20 efault-cmd).
be50: 20 20 6c 62 29 29 29 29 0a 0a 28 64 65 66 69 6e lb))))..(defin
be60: 65 20 28 64 63 6f 6d 6d 6f 6e 3a 63 6f 6d 6d 61 e (dcommon:comma
be70: 6e 64 2d 72 75 6e 6e 61 6d 65 2d 73 65 6c 65 63 nd-runname-selec
be80: 74 6f 72 20 63 6f 6d 6d 6f 6e 64 61 74 20 74 61 tor commondat ta
be90: 62 64 61 74 20 23 21 6b 65 79 20 28 74 61 62 2d bdat #!key (tab-
bea0: 6e 75 6d 20 23 66 29 29 20 3b 3b 20 61 6c 6c 64 num #f)) ;; alld
beb0: 61 74 20 64 61 74 61 29 0a 20 20 28 69 75 70 3a at data). (iup:
bec0: 66 72 61 6d 65 0a 20 20 20 23 3a 74 69 74 6c 65 frame. #:title
bed0: 20 22 52 75 6e 6e 61 6d 65 22 0a 20 20 20 28 6c "Runname". (l
bee0: 65 74 2a 20 28 28 64 65 66 61 75 6c 74 2d 72 75 et* ((default-ru
bef0: 6e 2d 6e 61 6d 65 20 28 73 65 63 6f 6e 64 73 2d n-name (seconds-
bf00: 3e 77 6f 72 6b 2d 77 65 65 6b 2f 64 61 79 20 28 >work-week/day (
bf10: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
bf20: 29 29 0a 09 20 20 28 74 62 20 28 69 75 70 3a 74 )).. (tb (iup:t
bf30: 65 78 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 extbox #:expand
bf40: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 "HORIZONTAL"....
bf50: 20 20 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d #:action (lam
bf60: 62 64 61 20 28 6f 62 6a 20 76 61 6c 20 74 78 74 bda (obj val txt
bf70: 29 0a 09 09 09 09 20 20 20 20 20 20 28 64 65 62 )..... (deb
bf80: 75 67 3a 63 61 74 63 68 2d 61 6e 64 2d 64 75 6d ug:catch-and-dum
bf90: 70 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c 61 p..... (la
bfa0: 6d 62 64 61 20 28 29 0a 09 09 09 09 09 20 3b 3b mbda ()...... ;;
bfb0: 20 28 70 72 69 6e 74 20 22 6f 62 6a 3a 20 22 20 (print "obj: "
bfc0: 6f 62 6a 20 22 20 76 61 6c 3a 20 22 20 76 61 6c obj " val: " val
bfd0: 20 22 20 75 6e 6b 3a 20 22 20 75 6e 6b 29 0a 09 " unk: " unk)..
bfe0: 09 09 09 09 20 28 64 62 6f 61 72 64 3a 74 61 62 .... (dboard:tab
bff0: 64 61 74 2d 72 75 6e 2d 6e 61 6d 65 2d 73 65 74 dat-run-name-set
c000: 21 20 74 61 62 64 61 74 20 74 78 74 29 20 3b 3b ! tabdat txt) ;;
c010: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 (iup:attribute
c020: 6f 62 6a 20 22 56 41 4c 55 45 22 29 29 0a 09 09 obj "VALUE"))...
c030: 09 09 09 20 28 64 61 73 68 62 6f 61 72 64 3a 75 ... (dashboard:u
c040: 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 6e pdate-run-comman
c050: 64 20 74 61 62 64 61 74 29 29 0a 09 09 09 09 20 d tabdat)).....
c060: 20 20 20 20 20 20 22 63 6f 6d 6d 61 6e 64 2d 72 "command-r
c070: 75 6e 6e 61 6d 65 2d 73 65 6c 65 63 74 6f 72 20 unname-selector
c080: 74 62 20 61 63 74 69 6f 6e 22 29 29 0a 09 09 09 tb action"))....
c090: 20 20 20 23 3a 76 61 6c 75 65 20 28 6f 72 20 64 #:value (or d
c0a0: 65 66 61 75 6c 74 2d 72 75 6e 2d 6e 61 6d 65 20 efault-run-name
c0b0: 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 72 (dboard:tabdat-r
c0c0: 75 6e 2d 6e 61 6d 65 20 74 61 62 64 61 74 29 29 un-name tabdat))
c0d0: 29 29 0a 09 20 20 28 6c 62 20 28 69 75 70 3a 6c )).. (lb (iup:l
c0e0: 69 73 74 62 6f 78 20 23 3a 65 78 70 61 6e 64 20 istbox #:expand
c0f0: 22 48 4f 52 49 5a 4f 4e 54 41 4c 22 0a 09 09 09 "HORIZONTAL"....
c100: 20 20 20 23 3a 64 72 6f 70 64 6f 77 6e 20 22 59 #:dropdown "Y
c110: 45 53 22 0a 09 09 09 20 20 20 23 3a 61 63 74 69 ES".... #:acti
c120: 6f 6e 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 on (lambda (obj
c130: 76 61 6c 20 69 6e 64 65 78 20 6c 62 73 74 61 74 val index lbstat
c140: 65 29 0a 09 09 09 09 20 20 20 20 20 20 28 64 65 e)..... (de
c150: 62 75 67 3a 63 61 74 63 68 2d 61 6e 64 2d 64 75 bug:catch-and-du
c160: 6d 70 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c mp..... (l
c170: 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 20 28 ambda ()...... (
c180: 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 if (not (equal?
c190: 76 61 6c 20 22 22 29 29 0a 09 09 09 09 09 20 20 val ""))......
c1a0: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 (begin......
c1b0: 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 (iup:attri
c1c0: 62 75 74 65 2d 73 65 74 21 20 74 62 20 22 56 41 bute-set! tb "VA
c1d0: 4c 55 45 22 20 76 61 6c 29 0a 09 09 09 09 09 20 LUE" val)......
c1e0: 20 20 20 20 20 20 28 64 62 6f 61 72 64 3a 74 61 (dboard:ta
c1f0: 62 64 61 74 2d 72 75 6e 2d 6e 61 6d 65 2d 73 65 bdat-run-name-se
c200: 74 21 20 74 61 62 64 61 74 20 76 61 6c 29 0a 09 t! tabdat val)..
c210: 09 09 09 09 20 20 20 20 20 20 20 28 64 61 73 68 .... (dash
c220: 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72 75 6e board:update-run
c230: 2d 63 6f 6d 6d 61 6e 64 20 74 61 62 64 61 74 29 -command tabdat)
c240: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 22 )))..... "
c250: 63 6f 6d 6d 61 6e 64 2d 72 75 6e 6e 61 6d 65 2d command-runname-
c260: 73 65 6c 65 63 74 6f 72 20 6c 62 20 61 63 74 69 selector lb acti
c270: 6f 6e 22 29 29 29 29 0a 09 20 20 28 72 65 66 72 on")))).. (refr
c280: 65 73 68 2d 72 75 6e 73 2d 6c 69 73 74 20 28 6c esh-runs-list (l
c290: 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 20 ambda ()....
c2a0: 20 20 20 28 69 66 20 28 64 61 73 68 62 6f 61 72 (if (dashboar
c2b0: 64 3a 64 61 74 61 62 61 73 65 2d 63 68 61 6e 67 d:database-chang
c2c0: 65 64 3f 20 63 6f 6d 6d 6f 6e 64 61 74 20 74 61 ed? commondat ta
c2d0: 62 64 61 74 20 63 6f 6e 74 65 78 74 2d 6b 65 79 bdat context-key
c2e0: 3a 20 27 72 75 6e 6e 61 6d 65 2d 73 65 6c 65 63 : 'runname-selec
c2f0: 74 6f 72 2d 72 75 6e 73 2d 6c 69 73 74 29 0a 09 tor-runs-list)..
c300: 09 09 09 20 20 20 28 6c 65 74 2a 20 28 3b 3b 20 ... (let* (;;
c310: 28 74 61 72 67 65 74 20 20 20 20 20 20 20 20 28 (target (
c320: 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 74 61 dboard:tabdat-ta
c330: 72 67 65 74 2d 73 74 72 69 6e 67 20 74 61 62 64 rget-string tabd
c340: 61 74 29 29 0a 09 09 09 09 09 20 20 28 72 75 6e at))...... (run
c350: 73 2d 66 6f 72 2d 74 61 72 67 20 28 72 6d 74 3a s-for-targ (rmt:
c360: 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 get-runs-by-patt
c370: 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d (dboard:tabdat-
c380: 6b 65 79 73 20 74 61 62 64 61 74 29 20 22 25 22 keys tabdat) "%"
c390: 20 23 66 20 23 66 20 23 66 20 23 66 20 30 29 29 #f #f #f #f 0))
c3a0: 0a 09 09 09 09 09 20 20 28 72 75 6e 73 2d 68 65 ...... (runs-he
c3b0: 61 64 65 72 20 20 20 28 76 65 63 74 6f 72 2d 72 ader (vector-r
c3c0: 65 66 20 72 75 6e 73 2d 66 6f 72 2d 74 61 72 67 ef runs-for-targ
c3d0: 20 30 29 29 0a 09 09 09 09 09 20 20 28 72 75 6e 0))...... (run
c3e0: 73 2d 64 61 74 20 20 20 20 20 20 28 76 65 63 74 s-dat (vect
c3f0: 6f 72 2d 72 65 66 20 72 75 6e 73 2d 66 6f 72 2d or-ref runs-for-
c400: 74 61 72 67 20 31 29 29 0a 09 09 09 09 09 20 20 targ 1))......
c410: 28 72 75 6e 2d 6e 61 6d 65 73 20 20 20 20 20 28 (run-names (
c420: 63 6f 6e 73 20 64 65 66 61 75 6c 74 2d 72 75 6e cons default-run
c430: 2d 6e 61 6d 65 20 0a 09 09 09 09 09 09 09 20 20 -name ........
c440: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
c450: 61 20 28 78 29 0a 09 09 09 09 09 09 09 09 20 20 a (x).........
c460: 20 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 (db:get-valu
c470: 65 2d 62 79 2d 68 65 61 64 65 72 20 78 20 72 75 e-by-header x ru
c480: 6e 73 2d 68 65 61 64 65 72 20 22 72 75 6e 6e 61 ns-header "runna
c490: 6d 65 22 29 29 0a 09 09 09 09 09 09 09 09 20 20 me")).........
c4a0: 20 20 72 75 6e 73 2d 64 61 74 29 29 29 29 0a 09 runs-dat))))..
c4b0: 09 09 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e ... ;; (prin
c4c0: 74 20 22 44 45 42 55 47 49 4e 46 4f 3a 20 72 75 t "DEBUGINFO: ru
c4d0: 6e 2d 6e 61 6d 65 73 3d 22 20 72 75 6e 2d 6e 61 n-names=" run-na
c4e0: 6d 65 73 29 0a 09 09 09 09 20 20 20 20 20 3b 3b mes)..... ;;
c4f0: 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d (iup:attribute-
c500: 73 65 74 21 20 6c 62 20 22 52 45 4d 4f 56 45 49 set! lb "REMOVEI
c510: 54 45 4d 22 20 22 41 4c 4c 22 29 0a 09 09 09 09 TEM" "ALL").....
c520: 20 20 20 20 20 28 69 75 70 6c 69 73 74 62 6f 78 (iuplistbox
c530: 2d 66 69 6c 6c 2d 6c 69 73 74 20 6c 62 20 72 75 -fill-list lb ru
c540: 6e 2d 6e 61 6d 65 73 20 73 65 6c 65 63 74 65 64 n-names selected
c550: 2d 69 74 65 6d 3a 20 64 65 66 61 75 6c 74 2d 72 -item: default-r
c560: 75 6e 2d 6e 61 6d 65 29 29 29 29 29 29 0a 20 20 un-name)))))).
c570: 20 20 20 3b 3b 20 28 64 62 6f 61 72 64 3a 74 61 ;; (dboard:ta
c580: 62 64 61 74 2d 75 70 64 61 74 65 72 2d 66 6f 72 bdat-updater-for
c590: 2d 72 75 6e 73 2d 73 65 74 21 20 74 61 62 64 61 -runs-set! tabda
c5a0: 74 20 72 65 66 72 65 73 68 2d 72 75 6e 73 2d 6c t refresh-runs-l
c5b0: 69 73 74 29 0a 20 20 20 20 20 28 64 62 6f 61 72 ist). (dboar
c5c0: 64 3a 63 6f 6d 6d 6f 6e 64 61 74 2d 61 64 64 2d d:commondat-add-
c5d0: 75 70 64 61 74 65 72 20 63 6f 6d 6d 6f 6e 64 61 updater commonda
c5e0: 74 20 72 65 66 72 65 73 68 2d 72 75 6e 73 2d 6c t refresh-runs-l
c5f0: 69 73 74 20 74 61 62 2d 6e 75 6d 3a 20 74 61 62 ist tab-num: tab
c600: 2d 6e 75 6d 29 0a 20 20 20 20 20 3b 3b 20 28 72 -num). ;; (r
c610: 65 66 72 65 73 68 2d 72 75 6e 73 2d 6c 69 73 74 efresh-runs-list
c620: 29 0a 20 20 20 20 20 28 64 62 6f 61 72 64 3a 74 ). (dboard:t
c630: 61 62 64 61 74 2d 72 75 6e 2d 6e 61 6d 65 2d 73 abdat-run-name-s
c640: 65 74 21 20 74 61 62 64 61 74 20 64 65 66 61 75 et! tabdat defau
c650: 6c 74 2d 72 75 6e 2d 6e 61 6d 65 29 0a 20 20 20 lt-run-name).
c660: 20 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20 20 (iup:hbox.
c670: 20 20 74 62 0a 20 20 20 20 20 20 6c 62 29 29 29 tb. lb)))
c680: 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 6f 6d )..(define (dcom
c690: 6d 6f 6e 3a 63 6f 6d 6d 61 6e 64 2d 74 65 73 74 mon:command-test
c6a0: 6e 61 6d 65 2d 73 65 6c 65 63 74 6f 72 20 63 6f name-selector co
c6b0: 6d 6d 6f 6e 64 61 74 20 74 61 62 64 61 74 20 75 mmondat tabdat u
c6c0: 70 64 61 74 65 2d 6b 65 79 76 61 6c 73 29 20 3b pdate-keyvals) ;
c6d0: 3b 20 20 6b 65 79 2d 6c 69 73 74 62 6f 78 65 73 ; key-listboxes
c6e0: 29 0a 20 20 28 69 75 70 3a 76 62 6f 78 0a 20 20 ). (iup:vbox.
c6f0: 20 3b 3b 20 54 65 78 74 20 62 6f 78 20 66 6f 72 ;; Text box for
c700: 20 74 65 73 74 20 70 61 74 74 65 72 6e 73 0a 20 test patterns.
c710: 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 20 (iup:frame.
c720: 20 23 3a 74 69 74 6c 65 20 22 54 65 73 74 20 70 #:title "Test p
c730: 61 74 74 65 72 6e 73 20 28 6f 6e 65 20 70 65 72 atterns (one per
c740: 20 6c 69 6e 65 29 22 0a 20 20 20 20 28 6c 65 74 line)". (let
c750: 20 28 28 74 62 20 28 69 75 70 3a 74 65 78 74 62 ((tb (iup:textb
c760: 6f 78 20 23 3a 61 63 74 69 6f 6e 20 28 6c 61 6d ox #:action (lam
c770: 62 64 61 20 28 76 61 6c 20 61 20 62 29 0a 09 09 bda (val a b)...
c780: 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 63 .. (debug:c
c790: 61 74 63 68 2d 61 6e 64 2d 64 75 6d 70 0a 09 09 atch-and-dump...
c7a0: 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
c7b0: 20 28 29 0a 09 09 09 09 09 20 28 64 62 6f 61 72 ()...... (dboar
c7c0: 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d 70 61 d:tabdat-test-pa
c7d0: 74 74 73 2d 73 65 74 21 2d 75 73 65 0a 09 09 09 tts-set!-use....
c7e0: 09 09 20 20 74 61 62 64 61 74 0a 09 09 09 09 09 .. tabdat......
c7f0: 20 20 28 64 62 6f 61 72 64 3a 6c 69 6e 65 73 2d (dboard:lines-
c800: 3e 74 65 73 74 2d 70 61 74 74 20 62 29 29 0a 09 >test-patt b))..
c810: 09 09 09 09 20 28 64 61 73 68 62 6f 61 72 64 3a .... (dashboard:
c820: 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 update-run-comma
c830: 6e 64 20 74 61 62 64 61 74 29 29 0a 09 09 09 09 nd tabdat)).....
c840: 20 20 20 20 20 20 20 22 63 6f 6d 6d 61 6e 64 2d "command-
c850: 74 65 73 74 6e 61 6d 65 2d 73 65 6c 65 63 74 6f testname-selecto
c860: 72 20 74 62 20 61 63 74 69 6f 6e 22 29 29 0a 09 r tb action"))..
c870: 09 09 20 20 20 23 3a 76 61 6c 75 65 20 28 64 62 .. #:value (db
c880: 6f 61 72 64 3a 74 65 73 74 2d 70 61 74 74 2d 3e oard:test-patt->
c890: 6c 69 6e 65 73 0a 09 09 09 09 20 20 20 20 28 64 lines..... (d
c8a0: 62 6f 61 72 64 3a 74 61 62 64 61 74 2d 74 65 73 board:tabdat-tes
c8b0: 74 2d 70 61 74 74 73 2d 75 73 65 20 74 61 62 64 t-patts-use tabd
c8c0: 61 74 29 29 0a 09 09 09 20 20 20 23 3a 65 78 70 at)).... #:exp
c8d0: 61 6e 64 20 22 59 45 53 22 0a 09 09 09 20 20 20 and "YES"....
c8e0: 23 3a 73 69 7a 65 20 22 78 33 30 22 20 3b 3b 20 #:size "x30" ;;
c8f0: 77 61 73 20 31 30 78 33 30 0a 09 09 09 20 20 20 was 10x30....
c900: 23 3a 6d 75 6c 74 69 6c 69 6e 65 20 22 59 45 53 #:multiline "YES
c910: 22 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 "))). (set!
c920: 20 74 65 73 74 2d 70 61 74 74 65 72 6e 73 2d 74 test-patterns-t
c930: 65 78 74 62 6f 78 20 74 62 29 0a 20 20 20 20 20 extbox tb).
c940: 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 74 2d (dboard:tabdat-
c950: 74 65 73 74 2d 70 61 74 74 65 72 6e 73 2d 74 65 test-patterns-te
c960: 78 74 62 6f 78 2d 73 65 74 21 20 74 61 62 64 61 xtbox-set! tabda
c970: 74 20 74 62 29 0a 20 20 20 20 20 20 74 62 29 29 t tb). tb))
c980: 0a 3b 3b 20 28 69 75 70 3a 66 72 61 6d 65 0a 3b .;; (iup:frame.;
c990: 3b 20 20 23 3a 74 69 74 6c 65 20 22 54 61 72 67 ; #:title "Targ
c9a0: 65 74 22 0a 3b 3b 20 20 3b 3b 20 54 61 72 67 65 et".;; ;; Targe
c9b0: 74 20 73 65 6c 65 63 74 6f 72 73 0a 3b 3b 20 20 t selectors.;;
c9c0: 28 61 70 70 6c 79 20 69 75 70 3a 68 62 6f 78 0a (apply iup:hbox.
c9d0: 3b 3b 20 09 20 20 20 28 6c 65 74 2a 20 28 28 64 ;; . (let* ((d
c9e0: 61 74 20 20 20 20 20 20 28 64 61 73 68 62 6f 61 at (dashboa
c9f0: 72 64 3a 75 70 64 61 74 65 2d 74 61 72 67 65 74 rd:update-target
ca00: 2d 73 65 6c 65 63 74 6f 72 20 74 61 62 64 61 74 -selector tabdat
ca10: 20 61 63 74 69 6f 6e 2d 70 72 6f 63 3a 20 75 70 action-proc: up
ca20: 64 61 74 65 2d 6b 65 79 76 61 6c 73 29 29 0a 3b date-keyvals)).;
ca30: 3b 20 09 09 20 20 28 6b 65 79 2d 6c 62 20 20 20 ; .. (key-lb
ca40: 28 63 61 72 20 64 61 74 29 29 0a 3b 3b 20 09 09 (car dat)).;; ..
ca50: 20 20 28 63 6f 6d 62 6f 73 20 20 20 28 63 61 64 (combos (cad
ca60: 72 20 64 61 74 29 29 29 0a 3b 3b 20 09 20 20 20 r dat))).;; .
ca70: 20 20 63 6f 6d 62 6f 73 29 29 29 0a 20 20 20 3b combos))). ;
ca80: 3b 20 28 69 75 70 3a 68 62 6f 78 0a 20 20 20 3b ; (iup:hbox. ;
ca90: 3b 20 20 3b 3b 20 54 65 78 74 20 62 6f 78 20 66 ; ;; Text box f
caa0: 6f 72 20 53 54 41 54 45 53 0a 20 20 20 3b 3b 20 or STATES. ;;
cab0: 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 20 3b (iup:frame. ;
cac0: 3b 20 20 20 23 3a 74 69 74 6c 65 20 22 53 74 61 ; #:title "Sta
cad0: 74 65 73 22 0a 20 20 20 3b 3b 20 20 20 28 64 61 tes". ;; (da
cae0: 73 68 62 6f 61 72 64 3a 74 65 78 74 2d 6c 69 73 shboard:text-lis
caf0: 74 2d 74 6f 67 67 6c 65 2d 62 6f 78 20 0a 20 20 t-toggle-box .
cb00: 20 3b 3b 20 20 20 20 3b 3b 20 4d 6f 76 65 20 74 ;; ;; Move t
cb10: 68 65 73 65 20 64 65 66 69 6e 69 74 69 6f 6e 73 hese definitions
cb20: 20 74 6f 20 63 6f 6d 6d 6f 6e 20 61 6e 64 20 66 to common and f
cb30: 69 6e 64 20 74 68 65 20 6f 74 68 65 72 20 75 73 ind the other us
cb40: 65 61 67 65 73 20 61 6e 64 20 72 65 70 6c 61 63 eages and replac
cb50: 65 21 0a 20 20 20 3b 3b 20 20 20 20 28 6d 61 70 e!. ;; (map
cb60: 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 cadr *common:st
cb70: 64 2d 73 74 61 74 65 73 2a 29 20 3b 3b 20 27 28 d-states*) ;; '(
cb80: 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 52 55 4e "COMPLETED" "RUN
cb90: 4e 49 4e 47 22 20 22 53 54 55 43 4b 22 20 22 49 NING" "STUCK" "I
cba0: 4e 43 4f 4d 50 4c 45 54 45 22 20 22 4c 41 55 4e NCOMPLETE" "LAUN
cbb0: 43 48 45 44 22 20 22 52 45 4d 4f 54 45 48 4f 53 CHED" "REMOTEHOS
cbc0: 54 53 54 41 52 54 22 20 22 4b 49 4c 4c 45 44 22 TSTART" "KILLED"
cbd0: 29 0a 20 20 20 3b 3b 20 20 20 20 28 6c 61 6d 62 ). ;; (lamb
cbe0: 64 61 20 28 61 6c 6c 29 0a 20 20 20 3b 3b 20 20 da (all). ;;
cbf0: 20 20 20 20 28 64 62 6f 61 72 64 3a 74 61 62 64 (dboard:tabd
cc00: 61 74 2d 73 74 61 74 65 73 2d 73 65 74 21 20 74 at-states-set! t
cc10: 61 62 64 61 74 20 61 6c 6c 29 0a 20 20 20 3b 3b abdat all). ;;
cc20: 20 20 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 (dashboard
cc30: 3a 75 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d :update-run-comm
cc40: 61 6e 64 20 74 61 62 64 61 74 29 29 29 29 0a 20 and tabdat)))).
cc50: 20 20 3b 3b 20 20 3b 3b 20 54 65 78 74 20 62 6f ;; ;; Text bo
cc60: 78 20 66 6f 72 20 53 54 41 54 45 53 0a 20 20 20 x for STATES.
cc70: 3b 3b 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 ;; (iup:frame.
cc80: 20 20 3b 3b 20 20 20 23 3a 74 69 74 6c 65 20 22 ;; #:title "
cc90: 53 74 61 74 75 73 65 73 22 0a 20 20 20 3b 3b 20 Statuses". ;;
cca0: 20 20 28 64 61 73 68 62 6f 61 72 64 3a 74 65 78 (dashboard:tex
ccb0: 74 2d 6c 69 73 74 2d 74 6f 67 67 6c 65 2d 62 6f t-list-toggle-bo
ccc0: 78 20 0a 20 20 20 3b 3b 20 20 20 20 28 6d 61 70 x . ;; (map
ccd0: 20 63 61 64 72 20 2a 63 6f 6d 6d 6f 6e 3a 73 74 cadr *common:st
cce0: 64 2d 73 74 61 74 75 73 65 73 2a 29 20 3b 3b 20 d-statuses*) ;;
ccf0: 27 28 22 50 41 53 53 22 20 22 46 41 49 4c 22 20 '("PASS" "FAIL"
cd00: 22 6e 2f 61 22 20 22 43 48 45 43 4b 22 20 22 57 "n/a" "CHECK" "W
cd10: 41 49 56 45 44 22 20 22 53 4b 49 50 22 20 22 44 AIVED" "SKIP" "D
cd20: 45 4c 45 54 45 44 22 20 22 53 54 55 43 4b 2f 44 ELETED" "STUCK/D
cd30: 45 41 44 22 29 0a 20 20 20 3b 3b 20 20 20 20 28 EAD"). ;; (
cd40: 6c 61 6d 62 64 61 20 28 61 6c 6c 29 0a 20 20 20 lambda (all).
cd50: 3b 3b 20 20 20 20 20 20 28 64 62 6f 61 72 64 3a ;; (dboard:
cd60: 74 61 62 64 61 74 2d 73 74 61 74 75 73 65 73 2d tabdat-statuses-
cd70: 73 65 74 21 20 74 61 62 64 61 74 20 61 6c 6c 29 set! tabdat all)
cd80: 0a 20 20 20 3b 3b 20 20 20 20 20 20 28 64 61 73 . ;; (das
cd90: 68 62 6f 61 72 64 3a 75 70 64 61 74 65 2d 72 75 hboard:update-ru
cda0: 6e 2d 63 6f 6d 6d 61 6e 64 20 74 61 62 64 61 74 n-command tabdat
cdb0: 29 29 29 29 29 0a 20 20 20 29 29 0a 0a 28 64 65 ))))). ))..(de
cdc0: 66 69 6e 65 20 28 64 63 6f 6d 6d 6f 6e 3a 63 6f fine (dcommon:co
cdd0: 6d 6d 61 6e 64 2d 74 65 73 74 73 2d 74 61 73 6b mmand-tests-task
cde0: 73 2d 63 61 6e 76 61 73 20 74 61 62 64 61 74 20 s-canvas tabdat
cdf0: 74 65 73 74 2d 72 65 63 6f 72 64 73 20 73 6f 72 test-records sor
ce00: 74 65 64 2d 74 65 73 74 6e 61 6d 65 73 20 74 65 ted-testnames te
ce10: 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 29 0a sts-draw-state).
ce20: 20 20 28 69 75 70 3a 66 72 61 6d 65 0a 20 20 20 (iup:frame.
ce30: 23 3a 74 69 74 6c 65 20 22 54 65 73 74 73 20 61 #:title "Tests a
ce40: 6e 64 20 54 61 73 6b 73 22 0a 20 20 20 28 6c 65 nd Tasks". (le
ce50: 74 2a 20 28 28 75 70 64 61 74 65 72 20 23 66 29 t* ((updater #f)
ce60: 0a 09 20 20 28 6c 61 73 74 2d 78 61 64 6a 20 30 .. (last-xadj 0
ce70: 29 0a 09 20 20 28 6c 61 73 74 2d 79 61 64 6a 20 ).. (last-yadj
ce80: 30 29 0a 09 20 20 28 74 68 65 2d 63 6e 76 20 20 0).. (the-cnv
ce90: 20 23 66 29 0a 09 20 20 28 63 61 6e 76 61 73 2d #f).. (canvas-
cea0: 6f 62 6a 20 0a 09 20 20 20 28 69 75 70 3a 63 61 obj .. (iup:ca
ceb0: 6e 76 61 73 20 23 3a 61 63 74 69 6f 6e 20 28 6d nvas #:action (m
cec0: 61 6b 65 2d 63 61 6e 76 61 73 2d 61 63 74 69 6f ake-canvas-actio
ced0: 6e 0a 09 09 09 09 20 28 6c 61 6d 62 64 61 20 28 n..... (lambda (
cee0: 63 6e 76 20 78 61 64 6a 20 79 61 64 6a 29 0a 09 cnv xadj yadj)..
cef0: 09 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 75 ... (if (not u
cf00: 70 64 61 74 65 72 29 0a 09 09 09 09 20 20 20 20 pdater).....
cf10: 20 20 20 28 73 65 74 21 20 75 70 64 61 74 65 72 (set! updater
cf20: 20 28 6c 61 6d 62 64 61 20 28 78 61 64 6a 20 79 (lambda (xadj y
cf30: 61 64 6a 29 0a 09 09 09 09 09 09 20 20 20 20 20 adj).......
cf40: 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 63 6e 76 ;; (print "cnv
cf50: 3a 20 22 20 63 6e 76 20 22 20 78 61 64 6a 3a 20 : " cnv " xadj:
cf60: 22 20 78 61 64 6a 20 22 20 79 61 64 6a 3a 20 22 " xadj " yadj: "
cf70: 20 79 61 64 6a 29 0a 09 09 09 09 09 09 20 20 20 yadj).......
cf80: 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 64 (dashboard:d
cf90: 72 61 77 2d 74 65 73 74 73 20 63 6e 76 20 78 61 raw-tests cnv xa
cfa0: 64 6a 20 79 61 64 6a 20 74 65 73 74 73 2d 64 72 dj yadj tests-dr
cfb0: 61 77 2d 73 74 61 74 65 20 73 6f 72 74 65 64 2d aw-state sorted-
cfc0: 74 65 73 74 6e 61 6d 65 73 20 74 65 73 74 2d 72 testnames test-r
cfd0: 65 63 6f 72 64 73 29 0a 09 09 09 09 09 09 20 20 ecords).......
cfe0: 20 20 20 20 20 28 73 65 74 21 20 6c 61 73 74 2d (set! last-
cff0: 78 61 64 6a 20 78 61 64 6a 29 0a 09 09 09 09 09 xadj xadj)......
d000: 09 20 20 20 20 20 20 20 28 73 65 74 21 20 6c 61 . (set! la
d010: 73 74 2d 79 61 64 6a 20 79 61 64 6a 29 29 29 29 st-yadj yadj))))
d020: 0a 09 09 09 09 20 20 20 28 75 70 64 61 74 65 72 ..... (updater
d030: 20 78 61 64 6a 20 79 61 64 6a 29 0a 09 09 09 09 xadj yadj).....
d040: 20 20 20 28 73 65 74 21 20 74 68 65 2d 63 6e 76 (set! the-cnv
d050: 20 63 6e 76 29 0a 09 09 09 09 20 20 20 29 29 0a cnv)..... )).
d060: 09 09 20 20 20 20 20 20 20 3b 3b 20 46 6f 6c 6c .. ;; Foll
d070: 6f 77 69 6e 67 20 64 6f 65 73 6e 27 74 20 77 6f owing doesn't wo
d080: 72 6b 20 0a 09 09 20 20 20 20 20 20 20 23 3a 77 rk ... #:w
d090: 68 65 65 6c 2d 63 62 20 28 6c 61 6d 62 64 61 20 heel-cb (lambda
d0a0: 28 6f 62 6a 20 73 74 65 70 20 78 20 79 20 64 69 (obj step x y di
d0b0: 72 29 20 3b 3b 20 64 69 72 20 69 73 20 34 20 66 r) ;; dir is 4 f
d0c0: 6f 72 20 75 70 20 61 6e 64 20 35 20 66 6f 72 20 or up and 5 for
d0d0: 64 6f 77 6e 2e 20 49 20 74 68 69 6e 6b 2e 0a 09 down. I think...
d0e0: 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 73 63 ... (let ((sc
d0f0: 61 6c 65 66 20 28 68 61 73 68 2d 74 61 62 6c 65 alef (hash-table
d100: 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d -ref tests-draw-
d110: 73 74 61 74 65 20 27 73 63 61 6c 65 66 29 29 29 state 'scalef)))
d120: 0a 09 09 09 09 20 20 20 20 20 20 28 68 61 73 68 ..... (hash
d130: 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 -table-set! test
d140: 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73 63 s-draw-state 'sc
d150: 61 6c 65 66 20 28 2b 20 73 63 61 6c 65 66 0a 09 alef (+ scalef..
d160: 09 09 09 09 09 09 09 09 09 20 20 20 28 69 66 20 ......... (if
d170: 28 3e 20 73 74 65 70 20 30 29 0a 09 09 09 09 09 (> step 0)......
d180: 09 09 09 09 09 20 20 20 20 20 20 20 28 2a 20 73 ..... (* s
d190: 63 61 6c 65 66 20 30 2e 30 31 29 0a 09 09 09 09 calef 0.01).....
d1a0: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 2a 20 ...... (*
d1b0: 73 63 61 6c 65 66 20 2d 30 2e 30 31 29 29 29 29 scalef -0.01))))
d1c0: 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 20 74 ..... (if t
d1d0: 68 65 2d 63 6e 76 0a 09 09 09 09 09 20 20 28 64 he-cnv...... (d
d1e0: 61 73 68 62 6f 61 72 64 3a 64 72 61 77 2d 74 65 ashboard:draw-te
d1f0: 73 74 73 20 74 68 65 2d 63 6e 76 20 6c 61 73 74 sts the-cnv last
d200: 2d 78 61 64 6a 20 6c 61 73 74 2d 79 61 64 6a 20 -xadj last-yadj
d210: 74 65 73 74 73 2d 64 72 61 77 2d 73 74 61 74 65 tests-draw-state
d220: 20 73 6f 72 74 65 64 2d 74 65 73 74 6e 61 6d 65 sorted-testname
d230: 73 20 74 65 73 74 2d 72 65 63 6f 72 64 73 29 29 s test-records))
d240: 0a 09 09 09 09 20 20 20 20 20 20 29 29 0a 09 09 ..... ))...
d250: 20 20 20 20 20 20 20 3b 3b 20 23 3a 73 69 7a 65 ;; #:size
d260: 20 22 32 35 30 78 32 35 30 22 0a 09 09 20 20 20 "250x250"...
d270: 20 20 20 20 23 3a 65 78 70 61 6e 64 20 22 59 45 #:expand "YE
d280: 53 22 0a 09 09 20 20 20 20 20 20 20 23 3a 73 63 S"... #:sc
d290: 72 6f 6c 6c 62 61 72 20 22 59 45 53 22 0a 09 09 rollbar "YES"...
d2a0: 20 20 20 20 20 20 20 23 3a 70 6f 73 78 20 22 30 #:posx "0
d2b0: 2e 35 22 0a 09 09 20 20 20 20 20 20 20 23 3a 70 .5"... #:p
d2c0: 6f 73 79 20 22 30 2e 35 22 0a 09 09 20 20 20 20 osy "0.5"...
d2d0: 20 20 20 23 3a 62 75 74 74 6f 6e 2d 63 62 20 28 #:button-cb (
d2e0: 6c 61 6d 62 64 61 20 28 6f 62 6a 20 62 74 6e 20 lambda (obj btn
d2f0: 70 72 65 73 73 65 64 20 78 20 79 20 73 74 61 74 pressed x y stat
d300: 75 73 29 0a 09 09 09 09 20 20 20 20 20 3b 3b 20 us)..... ;;
d310: 28 70 72 69 6e 74 20 22 6f 62 6a 3a 20 22 20 6f (print "obj: " o
d320: 62 6a 20 22 2c 20 70 72 65 73 73 65 64 20 22 20 bj ", pressed "
d330: 70 72 65 73 73 65 64 20 22 2c 20 73 74 61 74 75 pressed ", statu
d340: 73 20 22 20 73 74 61 74 75 73 29 0a 09 09 09 09 s " status).....
d350: 09 3b 20 28 70 72 69 6e 74 20 22 63 61 6e 76 61 .; (print "canva
d360: 73 2d 6f 72 69 67 69 6e 3a 20 22 20 28 63 61 6e s-origin: " (can
d370: 76 61 73 2d 6f 72 69 67 69 6e 20 74 68 65 2d 63 vas-origin the-c
d380: 6e 76 29 29 0a 09 09 09 09 20 20 20 20 20 3b 3b nv))..... ;;
d390: 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 (let-values (((
d3a0: 78 78 20 79 79 29 28 63 61 6e 76 61 73 2d 6f 72 xx yy)(canvas-or
d3b0: 69 67 69 6e 20 74 68 65 2d 63 6e 76 29 29 29 0a igin the-cnv))).
d3c0: 09 09 09 09 20 20 20 20 20 3b 3b 20 28 63 61 6e .... ;; (can
d3d0: 76 61 73 2d 74 72 61 6e 73 66 6f 72 6d 2d 73 65 vas-transform-se
d3e0: 74 21 20 74 68 65 2d 63 6e 76 20 23 66 29 0a 09 t! the-cnv #f)..
d3f0: 09 09 09 20 20 20 20 20 3b 3b 20 28 70 72 69 6e ... ;; (prin
d400: 74 20 22 63 61 6e 76 61 73 2d 6f 72 69 67 69 6e t "canvas-origin
d410: 3a 20 22 20 78 78 20 22 20 22 20 79 79 20 22 20 : " xx " " yy "
d420: 63 6c 69 63 6b 20 61 74 20 22 20 78 20 22 20 22 click at " x " "
d430: 20 79 29 29 0a 09 09 09 09 20 20 20 20 20 28 6c y))..... (l
d440: 65 74 2a 20 28 28 74 65 73 74 73 2d 69 6e 66 6f et* ((tests-info
d450: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
d460: 2d 72 65 66 20 74 65 73 74 73 2d 64 72 61 77 2d -ref tests-draw-
d470: 73 74 61 74 65 20 27 74 65 73 74 73 2d 69 6e 66 state 'tests-inf
d480: 6f 29 29 0a 09 09 09 09 09 20 20 20 20 28 73 65 o))...... (se
d490: 6c 65 63 74 65 64 2d 74 65 73 74 73 20 28 68 61 lected-tests (ha
d4a0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 sh-table-ref tes
d4b0: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73 ts-draw-state 's
d4c0: 65 6c 65 63 74 65 64 2d 74 65 73 74 73 29 29 0a elected-tests)).
d4d0: 09 09 09 09 09 20 20 20 20 28 73 63 61 6c 65 66 ..... (scalef
d4e0: 20 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 (hash-t
d4f0: 61 62 6c 65 2d 72 65 66 20 74 65 73 74 73 2d 64 able-ref tests-d
d500: 72 61 77 2d 73 74 61 74 65 20 27 73 63 61 6c 65 raw-state 'scale
d510: 66 29 29 0a 09 09 09 09 09 20 20 20 20 28 73 69 f))...... (si
d520: 7a 65 79 20 20 20 20 20 20 20 20 20 20 28 68 61 zey (ha
d530: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 sh-table-ref tes
d540: 74 73 2d 64 72 61 77 2d 73 74 61 74 65 20 27 73 ts-draw-state 's
d550: 69 7a 65 79 29 29 0a 09 09 09 09 09 20 20 20 20 izey))......
d560: 28 78 6f 66 66 73 65 74 20 20 20 20 20 20 20 20 (xoffset
d570: 28 64 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 78 6f 66 (dcommon:get-xof
d580: 66 73 65 74 20 74 65 73 74 73 2d 64 72 61 77 2d fset tests-draw-
d590: 73 74 61 74 65 20 23 66 20 23 66 29 29 0a 09 09 state #f #f))...
d5a0: 09 09 09 20 20 20 20 28 79 6f 66 66 73 65 74 20 ... (yoffset
d5b0: 20 20 20 20 20 20 20 28 64 63 6f 6d 6d 6f 6e 3a (dcommon:
d5c0: 67 65 74 2d 79 6f 66 66 73 65 74 20 74 65 73 74 get-yoffset test
d5d0: 73 2d 64 72 61 77 2d 73 74 61 74 65 20 23 66 20 s-draw-state #f
d5e0: 23 66 29 29 0a 09 09 09 09 09 20 20 20 20 28 6e #f))...... (n
d5f0: 65 77 2d 79 20 20 20 20 20 20 20 20 20 20 28 2d ew-y (-
d600: 20 73 69 7a 65 79 20 79 29 29 0a 09 09 09 09 09 sizey y))......
d610: 20 20 20 20 28 74 65 73 74 2d 70 61 74 74 65 72 (test-patter
d620: 6e 73 2d 74 65 78 74 62 6f 78 20 28 64 62 6f 61 ns-textbox (dboa
d630: 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d 70 rd:tabdat-test-p
d640: 61 74 74 65 72 6e 73 2d 74 65 78 74 62 6f 78 20 atterns-textbox
d650: 74 61 62 64 61 74 29 29 29 0a 09 09 09 09 20 20 tabdat))).....
d660: 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 ;; (print "
d670: 78 6f 66 66 73 65 74 3d 22 20 78 6f 66 66 73 65 xoffset=" xoffse
d680: 74 20 22 2c 20 79 6f 66 66 73 65 74 3d 22 20 79 t ", yoffset=" y
d690: 6f 66 66 73 65 74 29 0a 09 09 09 09 20 20 20 20 offset).....
d6a0: 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 5c 74 ;; (print "\t
d6b0: 78 5c 74 79 5c 74 6c 6c 78 5c 74 6c 6c 79 5c 74 x\ty\tllx\tlly\t
d6c0: 75 72 78 5c 74 75 72 79 22 29 0a 09 09 09 09 20 urx\tury").....
d6d0: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
d6e0: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 6e 61 (lambda (test-na
d6f0: 6d 65 29 0a 09 09 09 09 09 09 20 20 20 28 6c 65 me)....... (le
d700: 74 2a 20 28 28 72 65 63 2d 63 6f 6f 72 64 73 20 t* ((rec-coords
d710: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
d720: 74 65 73 74 73 2d 69 6e 66 6f 20 74 65 73 74 2d tests-info test-
d730: 6e 61 6d 65 29 29 0a 09 09 09 09 09 09 09 20 20 name))........
d740: 28 6c 6c 78 20 20 20 20 20 20 20 20 28 64 63 6f (llx (dco
d750: 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 73 20 28 mmon:x->canvas (
d760: 6c 69 73 74 2d 72 65 66 20 72 65 63 2d 63 6f 6f list-ref rec-coo
d770: 72 64 73 20 30 29 20 73 63 61 6c 65 66 20 78 6f rds 0) scalef xo
d780: 66 66 73 65 74 29 29 0a 09 09 09 09 09 09 09 20 ffset))........
d790: 20 28 6c 6c 79 20 20 20 20 20 20 20 20 28 64 63 (lly (dc
d7a0: 6f 6d 6d 6f 6e 3a 79 2d 3e 63 61 6e 76 61 73 20 ommon:y->canvas
d7b0: 28 6c 69 73 74 2d 72 65 66 20 72 65 63 2d 63 6f (list-ref rec-co
d7c0: 6f 72 64 73 20 31 29 20 73 63 61 6c 65 66 20 79 ords 1) scalef y
d7d0: 6f 66 66 73 65 74 29 29 0a 09 09 09 09 09 09 09 offset))........
d7e0: 20 20 28 75 72 78 20 20 20 20 20 20 20 20 28 64 (urx (d
d7f0: 63 6f 6d 6d 6f 6e 3a 78 2d 3e 63 61 6e 76 61 73 common:x->canvas
d800: 20 28 6c 69 73 74 2d 72 65 66 20 72 65 63 2d 63 (list-ref rec-c
d810: 6f 6f 72 64 73 20 32 29 20 73 63 61 6c 65 66 20 oords 2) scalef
d820: 78 6f 66 66 73 65 74 29 29 0a 09 09 09 09 09 09 xoffset)).......
d830: 09 20 20 28 75 72 79 20 20 20 20 20 20 20 20 28 . (ury (
d840: 64 63 6f 6d 6d 6f 6e 3a 79 2d 3e 63 61 6e 76 61 dcommon:y->canva
d850: 73 20 28 6c 69 73 74 2d 72 65 66 20 72 65 63 2d s (list-ref rec-
d860: 63 6f 6f 72 64 73 20 33 29 20 73 63 61 6c 65 66 coords 3) scalef
d870: 20 79 6f 66 66 73 65 74 29 29 29 0a 09 09 09 09 yoffset))).....
d880: 09 09 20 20 20 20 20 3b 3b 20 28 69 66 20 28 65 .. ;; (if (e
d890: 71 3f 20 70 72 65 73 73 65 64 20 31 29 0a 09 09 q? pressed 1)...
d8a0: 09 09 09 09 20 20 20 20 20 3b 3b 20 20 20 20 28 .... ;; (
d8b0: 70 72 69 6e 74 20 22 5c 74 78 3d 22 20 78 20 22 print "\tx=" x "
d8c0: 5c 74 79 3d 22 20 79 20 22 5c 74 6e 65 77 2d 79 \ty=" y "\tnew-y
d8d0: 3d 22 20 6e 65 77 2d 79 20 22 5c 74 6c 6c 78 3d =" new-y "\tllx=
d8e0: 22 20 6c 6c 78 20 22 5c 74 6c 6c 79 3d 22 20 6c " llx "\tlly=" l
d8f0: 6c 79 20 22 5c 74 75 72 78 3d 22 20 75 72 78 20 ly "\turx=" urx
d900: 22 5c 74 75 72 79 3d 22 20 75 72 79 20 22 5c 74 "\tury=" ury "\t
d910: 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 22 29 " test-name " ")
d920: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 69 66 )....... (if
d930: 20 28 61 6e 64 20 28 65 71 3f 20 70 72 65 73 73 (and (eq? press
d940: 65 64 20 31 29 0a 09 09 09 09 09 09 09 20 20 20 ed 1)........
d950: 20 20 20 28 3e 3d 20 78 20 6c 6c 78 29 0a 09 09 (>= x llx)...
d960: 09 09 09 09 09 20 20 20 20 20 20 28 3e 3d 20 6e ..... (>= n
d970: 65 77 2d 79 20 6c 6c 79 29 0a 09 09 09 09 09 09 ew-y lly).......
d980: 09 20 20 20 20 20 20 28 3c 3d 20 78 20 75 72 78 . (<= x urx
d990: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 28 )........ (
d9a0: 3c 3d 20 6e 65 77 2d 79 20 75 72 79 29 29 0a 09 <= new-y ury))..
d9b0: 09 09 09 09 09 09 20 28 6c 65 74 2a 20 28 28 62 ...... (let* ((b
d9c0: 6f 78 2d 70 61 74 74 65 72 6e 73 20 28 73 74 72 ox-patterns (str
d9d0: 69 6e 67 2d 73 70 6c 69 74 20 28 69 75 70 3a 61 ing-split (iup:a
d9e0: 74 74 72 69 62 75 74 65 20 74 65 73 74 2d 70 61 ttribute test-pa
d9f0: 74 74 65 72 6e 73 2d 74 65 78 74 62 6f 78 20 22 tterns-textbox "
da00: 56 41 4c 55 45 22 29 29 29 0a 20 20 20 20 20 20 VALUE"))).
da10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da40: 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74 2d (test-
da50: 70 61 74 74 73 20 20 20 28 73 74 72 69 6e 67 2d patts (string-
da60: 73 70 6c 69 74 20 28 6f 72 20 28 64 62 6f 61 72 split (or (dboar
da70: 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d 70 61 d:tabdat-test-pa
da80: 74 74 73 20 74 61 62 64 61 74 29 0a 20 20 20 20 tts tabdat).
da90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
daa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dab0: 20 20 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 20 20
dad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dae0: 20 20 20 20 20 20 20 20 20 20 20 20 22 22 29 0a "").
daf0: 20 20 20 20 20 20 20 20 20 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 20 20 20 20 20 20 20 20 20 20 20 20
db20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db40: 20 20 20 20 20 20 20 20 20 20 20 20 22 2c 22 29 ",")
db50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
db60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db90: 20 20 28 70 61 74 74 65 72 6e 73 20 20 20 20 20 (patterns
dba0: 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 (delete-duplicat
dbb0: 65 73 20 28 61 70 70 65 6e 64 20 62 6f 78 2d 70 es (append box-p
dbc0: 61 74 74 65 72 6e 73 20 74 65 73 74 2d 70 61 74 atterns test-pat
dbd0: 74 73 29 29 29 29 20 0a 09 09 09 09 09 09 09 20 ts)))) ........
dbe0: 20 20 28 6c 65 74 2a 20 28 28 73 65 6c 65 63 74 (let* ((select
dbf0: 65 64 20 20 20 20 20 28 6e 6f 74 20 28 6d 65 6d ed (not (mem
dc00: 62 65 72 20 74 65 73 74 2d 6e 61 6d 65 20 70 61 ber test-name pa
dc10: 74 74 65 72 6e 73 29 29 29 0a 09 09 09 09 09 09 tterns))).......
dc20: 09 09 20 20 28 6e 65 77 70 61 74 74 2d 6c 69 73 .. (newpatt-lis
dc30: 74 20 28 69 66 20 73 65 6c 65 63 74 65 64 0a 09 t (if selected..
dc40: 09 09 09 09 09 09 09 09 09 20 20 20 20 28 63 6f ......... (co
dc50: 6e 73 20 74 65 73 74 2d 6e 61 6d 65 20 70 61 74 ns test-name pat
dc60: 74 65 72 6e 73 29 0a 09 09 09 09 09 09 09 09 09 terns)..........
dc70: 09 20 20 20 20 28 64 65 6c 65 74 65 20 74 65 73 . (delete tes
dc80: 74 2d 6e 61 6d 65 20 70 61 74 74 65 72 6e 73 29 t-name patterns)
dc90: 29 29 0a 09 09 09 09 09 09 09 09 20 20 28 6e 65 ))......... (ne
dca0: 77 70 61 74 74 20 20 20 20 20 20 28 73 74 72 69 wpatt (stri
dcb0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6e ng-intersperse n
dcc0: 65 77 70 61 74 74 2d 6c 69 73 74 20 22 5c 6e 22 ewpatt-list "\n"
dcd0: 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 )))........
dce0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
dcf0: 65 74 21 20 74 65 73 74 2d 70 61 74 74 65 72 6e et! test-pattern
dd00: 73 2d 74 65 78 74 62 6f 78 20 22 56 41 4c 55 45 s-textbox "VALUE
dd10: 22 20 6e 65 77 70 61 74 74 29 0a 09 09 09 09 09 " newpatt)......
dd20: 09 09 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 .. (iup:attr
dd30: 69 62 75 74 65 2d 73 65 74 21 20 6f 62 6a 20 22 ibute-set! obj "
dd40: 52 45 44 52 41 57 22 20 22 41 4c 4c 22 29 0a 09 REDRAW" "ALL")..
dd50: 09 09 09 09 09 09 20 20 20 20 20 28 68 61 73 68 ...... (hash
dd60: 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 65 6c 65 -table-set! sele
dd70: 63 74 65 64 2d 74 65 73 74 73 20 74 65 73 74 2d cted-tests test-
dd80: 6e 61 6d 65 20 73 65 6c 65 63 74 65 64 29 0a 09 name selected)..
dd90: 09 09 09 09 09 09 20 20 20 20 20 28 64 62 6f 61 ...... (dboa
dda0: 72 64 3a 74 61 62 64 61 74 2d 74 65 73 74 2d 70 rd:tabdat-test-p
ddb0: 61 74 74 73 2d 73 65 74 21 2d 75 73 65 20 74 61 atts-set!-use ta
ddc0: 62 64 61 74 20 28 64 62 6f 61 72 64 3a 6c 69 6e bdat (dboard:lin
ddd0: 65 73 2d 3e 74 65 73 74 2d 70 61 74 74 20 6e 65 es->test-patt ne
dde0: 77 70 61 74 74 29 29 0a 09 09 09 09 09 09 09 20 wpatt))........
ddf0: 20 20 20 20 28 64 61 73 68 62 6f 61 72 64 3a 75 (dashboard:u
de00: 70 64 61 74 65 2d 72 75 6e 2d 63 6f 6d 6d 61 6e pdate-run-comman
de10: 64 20 74 61 62 64 61 74 29 0a 09 09 09 09 09 09 d tabdat).......
de20: 09 20 20 20 20 20 28 69 66 20 75 70 64 61 74 65 . (if update
de30: 72 20 28 75 70 64 61 74 65 72 20 6c 61 73 74 2d r (updater last-
de40: 78 61 64 6a 20 6c 61 73 74 2d 79 61 64 6a 29 29 xadj last-yadj))
de50: 29 29 29 29 29 0a 09 09 09 09 09 09 20 28 68 61 )))))....... (ha
de60: 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 74 65 sh-table-keys te
de70: 73 74 73 2d 69 6e 66 6f 29 29 29 29 29 29 29 0a sts-info))))))).
de80: 20 20 20 20 20 63 61 6e 76 61 73 2d 6f 62 6a 29 canvas-obj)
de90: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
dea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
deb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
dec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ded0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
dee0: 20 53 20 54 20 45 20 50 20 53 0a 3b 3b 3d 3d 3d S T E P S.;;===
def0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
df30: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 63 ===..(define (dc
df40: 6f 6d 6d 6f 6e 3a 70 6f 70 75 6c 61 74 65 2d 73 ommon:populate-s
df50: 74 65 70 73 20 74 65 73 74 73 74 65 70 73 20 73 teps teststeps s
df60: 74 65 70 73 2d 6d 61 74 72 69 78 20 72 75 6e 2d teps-matrix run-
df70: 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 28 6c id test-id). (l
df80: 65 74 2a 20 28 28 6d 61 78 2d 72 6f 77 20 20 20 et* ((max-row
df90: 20 20 20 20 30 29 0a 09 20 28 6d 61 78 2d 63 6f 0).. (max-co
dfa0: 6c 20 20 20 20 20 20 20 39 29 0a 20 20 20 20 20 l 9).
dfb0: 20 20 20 20 28 77 68 69 74 65 20 20 20 20 20 20 (white
dfc0: 20 20 20 22 32 35 35 20 32 35 35 20 32 35 35 22 "255 255 255"
dfd0: 29 0a 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 ). .
dfe0: 20 20 20 20 20 28 74 65 73 74 69 6e 66 6f 20 20 (testinfo
dff0: 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 (rmt:get-tes
e000: 74 69 6e 66 6f 2d 73 74 61 74 65 2d 73 74 61 74 tinfo-state-stat
e010: 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 us run-id test-i
e020: 64 29 29 0a 20 20 20 20 20 20 20 20 20 28 73 74 d)). (st
e030: 61 74 65 20 20 20 20 20 20 20 20 20 28 64 62 3a ate (db:
e040: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
e050: 65 73 74 69 6e 66 6f 29 29 0a 20 20 20 20 20 20 estinfo)).
e060: 20 20 20 28 73 74 61 74 75 73 20 20 20 20 20 20 (status
e070: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 (db:test-get-s
e080: 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29 29 tatus testinfo))
e090: 0a 20 20 20 20 20 20 20 20 20 28 74 65 73 74 2d . (test-
e0a0: 73 74 61 74 75 73 2d 63 6f 6c 6f 72 20 28 63 61 status-color (ca
e0b0: 72 20 28 67 75 74 69 6c 73 3a 67 65 74 2d 63 6f r (gutils:get-co
e0c0: 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 lor-for-state-st
e0d0: 61 74 75 73 20 73 74 61 74 65 20 73 74 61 74 75 atus state statu
e0e0: 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 s))). (r
e0f0: 75 6e 6e 69 6e 67 2d 63 6f 6c 6f 72 20 28 63 61 unning-color (ca
e100: 72 20 28 67 75 74 69 6c 73 3a 67 65 74 2d 63 6f r (gutils:get-co
e110: 6c 6f 72 2d 66 6f 72 2d 73 74 61 74 65 2d 73 74 lor-for-state-st
e120: 61 74 75 73 20 22 52 55 4e 4e 49 4e 47 22 20 22 atus "RUNNING" "
e130: 53 54 41 52 54 45 44 22 29 29 29 0a 20 20 20 20 STARTED"))).
e140: 20 20 20 20 20 28 66 61 69 6c 63 6f 6c 6f 72 20 (failcolor
e150: 20 20 20 20 28 63 61 72 20 28 67 75 74 69 6c 73 (car (gutils
e160: 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 :get-color-for-s
e170: 74 61 74 65 2d 73 74 61 74 75 73 20 22 43 4f 4d tate-status "COM
e180: 50 4c 45 54 45 44 22 20 22 46 41 49 4c 22 29 29 PLETED" "FAIL"))
e190: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c )). (if (null
e1a0: 3f 20 74 65 73 74 73 74 65 70 73 29 0a 09 28 62 ? teststeps)..(b
e1b0: 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 28 egin. (
e1c0: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
e1d0: 74 21 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 t! steps-matrix
e1e0: 22 43 4c 45 41 52 41 54 54 52 49 42 22 20 22 43 "CLEARATTRIB" "C
e1f0: 4f 4e 54 45 4e 54 53 22 29 0a 20 20 20 20 20 20 ONTENTS").
e200: 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 (iup:attribu
e210: 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d 6d 61 te-set! steps-ma
e220: 74 72 69 78 20 22 43 4c 45 41 52 56 41 4c 55 45 trix "CLEARVALUE
e230: 22 20 22 43 4f 4e 54 45 4e 54 53 22 29 29 0a 09 " "CONTENTS"))..
e240: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 (let loop ((hed
e250: 20 20 20 28 63 61 72 20 74 65 73 74 73 74 65 70 (car teststep
e260: 73 29 29 0a 09 09 20 20 20 28 74 61 6c 20 20 20 s))... (tal
e270: 20 28 63 64 72 20 74 65 73 74 73 74 65 70 73 29 (cdr teststeps)
e280: 29 0a 09 09 20 20 20 28 72 6f 77 6e 75 6d 20 31 )... (rownum 1
e290: 29 0a 09 09 20 20 20 28 63 6f 6c 6e 75 6d 20 31 )... (colnum 1
e2a0: 29 29 0a 09 20 20 28 69 66 20 28 3e 20 72 6f 77 )).. (if (> row
e2b0: 6e 75 6d 20 6d 61 78 2d 72 6f 77 29 28 73 65 74 num max-row)(set
e2c0: 21 20 6d 61 78 2d 72 6f 77 20 72 6f 77 6e 75 6d ! max-row rownum
e2d0: 29 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 73 74 )).. (let* ((st
e2e0: 61 74 75 73 20 20 28 76 65 63 74 6f 72 2d 72 65 atus (vector-re
e2f0: 66 20 68 65 64 20 33 29 29 0a 20 20 20 20 20 20 f hed 3)).
e300: 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 20 (val
e310: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
e320: 68 65 64 20 28 2d 20 63 6f 6c 6e 75 6d 20 31 29 hed (- colnum 1)
e330: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
e340: 20 20 20 20 28 62 67 63 6f 6c 6f 72 20 28 63 6f (bgcolor (co
e350: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
e360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
e370: 6d 65 6d 62 65 72 20 28 63 6f 6e 63 20 73 74 61 member (conc sta
e380: 74 75 73 29 20 27 28 22 22 20 22 2d 22 20 22 23 tus) '("" "-" "#
e390: 3c 75 6e 73 70 65 63 69 66 69 65 64 3e 22 29 29 <unspecified>"))
e3a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
e3b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 75 6e run
e3c0: 6e 69 6e 67 2d 63 6f 6c 6f 72 29 0a 20 20 20 20 ning-color).
e3d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e3e0: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 .
e3f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e400: 20 20 20 28 28 6d 65 6d 62 65 72 20 28 63 6f 6e ((member (con
e410: 63 20 73 74 61 74 75 73 29 20 27 28 22 30 22 20 c status) '("0"
e420: 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 0)).
e430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e440: 77 68 69 74 65 29 0a 20 20 20 20 20 20 20 20 20 white).
e450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e460: 20 20 28 65 6c 73 65 20 74 65 73 74 2d 73 74 61 (else test-sta
e470: 74 75 73 2d 63 6f 6c 6f 72 29 29 29 0a 20 20 20 tus-color))).
e480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e490: 20 20 20 20 20 20 20 3b 20 28 65 6c 73 65 20 66 ; (else f
e4a0: 61 69 6c 63 6f 6c 6f 72 29 29 29 0a 09 09 20 28 ailcolor)))... (
e4b0: 6d 74 72 78 2d 72 63 20 28 63 6f 6e 63 20 72 6f mtrx-rc (conc ro
e4c0: 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 wnum ":" colnum)
e4d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 3b )). ;
e4e0: 3b 28 70 72 69 6e 74 20 22 42 42 3e 20 73 74 61 ;(print "BB> sta
e4f0: 74 75 73 3d 3e 22 73 74 61 74 75 73 22 3c 20 62 tus=>"status"< b
e500: 67 63 6f 6c 6f 72 3d 22 62 67 63 6f 6c 6f 72 29 gcolor="bgcolor)
e510: 0a 09 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 .. (iup:attri
e520: 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d bute-set! steps-
e530: 6d 61 74 72 69 78 20 20 6d 74 72 78 2d 72 63 20 matrix mtrx-rc
e540: 28 69 66 20 76 61 6c 20 28 63 6f 6e 63 20 76 61 (if val (conc va
e550: 6c 29 20 22 22 29 29 0a 20 20 20 20 20 20 20 20 l) "")).
e560: 20 20 20 20 28 69 66 20 28 3c 20 63 6f 6c 6e 75 (if (< colnu
e570: 6d 20 35 29 0a 20 20 20 20 20 20 20 20 20 20 20 m 5).
e580: 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 (iup:attrib
e590: 75 74 65 2d 73 65 74 21 20 73 74 65 70 73 2d 6d ute-set! steps-m
e5a0: 61 74 72 69 78 20 20 28 63 6f 6e 63 20 22 42 47 atrix (conc "BG
e5b0: 43 4f 4c 4f 52 22 20 6d 74 72 78 2d 72 63 29 20 COLOR" mtrx-rc)
e5c0: 62 67 63 6f 6c 6f 72 29 29 0a 09 20 20 20 20 28 bgcolor)).. (
e5d0: 69 66 20 28 3c 20 63 6f 6c 6e 75 6d 20 6d 61 78 if (< colnum max
e5e0: 2d 63 6f 6c 29 0a 09 09 28 6c 6f 6f 70 20 68 65 -col)...(loop he
e5f0: 64 20 74 61 6c 20 72 6f 77 6e 75 6d 20 28 2b 20 d tal rownum (+
e600: 63 6f 6c 6e 75 6d 20 31 29 29 0a 09 09 28 69 66 colnum 1))...(if
e610: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c (not (null? tal
e620: 29 29 0a 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 ))... (loop (
e630: 63 61 72 20 74 61 6c 29 20 28 63 64 72 20 74 61 car tal) (cdr ta
e640: 6c 29 20 28 2b 20 72 6f 77 6e 75 6d 20 31 29 20 l) (+ rownum 1)
e650: 31 29 29 29 29 29 29 0a 20 20 20 20 28 69 66 20 1)))))). (if
e660: 28 3e 20 6d 61 78 2d 72 6f 77 20 30 29 0a 09 28 (> max-row 0)..(
e670: 62 65 67 69 6e 0a 09 20 20 3b 3b 20 77 65 20 61 begin.. ;; we a
e680: 72 65 20 67 6f 69 6e 67 20 74 6f 20 73 70 65 63 re going to spec
e690: 75 6c 61 74 69 76 65 6c 79 20 63 6c 65 61 72 20 ulatively clear
e6a0: 72 6f 77 73 20 75 6e 74 69 6c 20 77 65 20 66 69 rows until we fi
e6b0: 6e 64 20 61 20 72 6f 77 20 74 68 61 74 20 69 73 nd a row that is
e6c0: 20 61 6c 72 65 61 64 79 20 63 6c 65 61 72 65 64 already cleared
e6d0: 0a 09 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 .. (let loop ((
e6e0: 72 6f 77 6e 75 6d 20 20 28 2b 20 6d 61 78 2d 72 rownum (+ max-r
e6f0: 6f 77 20 31 29 29 0a 09 09 20 20 20 20 20 28 63 ow 1))... (c
e700: 6f 6c 6e 75 6d 20 20 30 29 0a 09 09 20 20 20 20 olnum 0)...
e710: 20 28 64 65 6c 65 74 65 64 20 23 66 29 29 0a 09 (deleted #f))..
e720: 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
e730: 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
e740: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 ult-log-port* "c
e750: 6c 65 61 6e 69 6e 67 20 22 20 72 6f 77 6e 75 6d leaning " rownum
e760: 20 22 3a 22 20 63 6f 6c 6e 75 6d 29 0a 09 20 20 ":" colnum)..
e770: 20 20 28 6c 65 74 2a 20 28 28 6e 65 78 74 2d 72 (let* ((next-r
e780: 6f 77 20 28 69 66 20 28 65 71 3f 20 63 6f 6c 6e ow (if (eq? coln
e790: 75 6d 20 6d 61 78 2d 63 6f 6c 29 20 28 2b 20 72 um max-col) (+ r
e7a0: 6f 77 6e 75 6d 20 31 29 20 72 6f 77 6e 75 6d 29 ownum 1) rownum)
e7b0: 29 0a 09 09 20 20 20 28 6e 65 78 74 2d 63 6f 6c )... (next-col
e7c0: 20 28 69 66 20 28 65 71 3f 20 63 6f 6c 6e 75 6d (if (eq? colnum
e7d0: 20 6d 61 78 2d 63 6f 6c 29 20 31 20 28 2b 20 63 max-col) 1 (+ c
e7e0: 6f 6c 6e 75 6d 20 31 29 29 29 0a 09 09 20 20 20 olnum 1)))...
e7f0: 28 6d 74 72 78 2d 72 63 20 20 28 63 6f 6e 63 20 (mtrx-rc (conc
e800: 72 6f 77 6e 75 6d 20 22 3a 22 20 63 6f 6c 6e 75 rownum ":" colnu
e810: 6d 29 29 0a 09 09 20 20 20 28 63 75 72 72 2d 76 m))... (curr-v
e820: 61 6c 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 al (iup:attribut
e830: 65 20 73 74 65 70 73 2d 6d 61 74 72 69 78 20 6d e steps-matrix m
e840: 74 72 78 2d 72 63 29 29 29 0a 09 20 20 20 20 20 trx-rc)))..
e850: 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ;; (debug:print
e860: 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
e870: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 6c 65 61 -log-port* "clea
e880: 6e 69 6e 67 20 22 20 72 6f 77 6e 75 6d 20 22 3a ning " rownum ":
e890: 22 20 63 6f 6c 6e 75 6d 20 22 20 63 75 72 72 76 " colnum " currv
e8a0: 61 6c 3d 20 22 20 63 75 72 72 2d 76 61 6c 29 0a al= " curr-val).
e8b0: 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 . (if (and
e8c0: 28 73 74 72 69 6e 67 3f 20 63 75 72 72 2d 76 61 (string? curr-va
e8d0: 6c 29 0a 09 09 20 20 20 20 20 20 20 28 6e 6f 74 l)... (not
e8e0: 20 28 65 71 75 61 6c 3f 20 63 75 72 72 2d 76 61 (equal? curr-va
e8f0: 6c 20 22 22 29 29 29 0a 09 09 20 20 28 62 65 67 l "")))... (beg
e900: 69 6e 0a 09 09 20 20 20 20 28 69 75 70 3a 61 74 in... (iup:at
e910: 74 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 tribute-set! ste
e920: 70 73 2d 6d 61 74 72 69 78 20 6d 74 72 78 2d 72 ps-matrix mtrx-r
e930: 63 20 22 22 29 0a 09 09 20 20 20 20 28 6c 6f 6f c "")... (loo
e940: 70 20 6e 65 78 74 2d 72 6f 77 20 6e 65 78 74 2d p next-row next-
e950: 63 6f 6c 20 23 74 29 29 0a 09 09 20 20 28 69 66 col #t))... (if
e960: 20 28 65 71 3f 20 63 6f 6c 6e 75 6d 20 6d 61 78 (eq? colnum max
e970: 2d 63 6f 6c 29 20 3b 3b 20 6e 6f 74 20 64 6f 6e -col) ;; not don
e980: 65 2c 20 64 69 64 6e 27 74 20 67 65 74 20 61 20 e, didn't get a
e990: 66 75 6c 6c 20 62 6c 61 6e 6b 20 72 6f 77 0a 09 full blank row..
e9a0: 09 20 20 20 20 20 20 28 69 66 20 64 65 6c 65 74 . (if delet
e9b0: 65 64 20 28 6c 6f 6f 70 20 6e 65 78 74 2d 72 6f ed (loop next-ro
e9c0: 77 20 6e 65 78 74 2d 63 6f 6c 20 23 66 29 29 20 w next-col #f))
e9d0: 3b 3b 20 65 78 69 74 20 6f 6e 20 74 68 69 73 20 ;; exit on this
e9e0: 6e 6f 74 20 6d 65 74 0a 09 09 20 20 20 20 20 20 not met...
e9f0: 28 6c 6f 6f 70 20 6e 65 78 74 2d 72 6f 77 20 6e (loop next-row n
ea00: 65 78 74 2d 63 6f 6c 20 64 65 6c 65 74 65 64 29 ext-col deleted)
ea10: 29 29 29 29 0a 09 20 20 28 69 75 70 3a 61 74 74 )))).. (iup:att
ea20: 72 69 62 75 74 65 2d 73 65 74 21 20 73 74 65 70 ribute-set! step
ea30: 73 2d 6d 61 74 72 69 78 20 22 52 45 44 52 41 57 s-matrix "REDRAW
ea40: 22 20 22 41 4c 4c 22 29 29 29 29 29 0a 0a 3b 3b " "ALL")))))..;;
ea50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ea60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ea70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ea80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ea90: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 55 20 54 20 49 20 ======.;; U T I
eaa0: 4c 20 49 20 54 20 49 20 45 20 53 0a 3b 3b 3d 3d L I T I E S.;;==
eab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ead0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eaf0: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 ====..(define (d
eb00: 63 6f 6d 6d 6f 6e 3a 72 75 6e 2d 68 74 6d 6c 2d common:run-html-
eb10: 76 69 65 77 65 72 20 6c 66 69 6c 65 6e 61 6d 65 viewer lfilename
eb20: 29 0a 20 20 28 6c 65 74 20 28 28 68 74 6d 6c 76 ). (let ((htmlv
eb30: 69 65 77 65 72 63 6d 64 20 28 63 6f 6e 66 69 67 iewercmd (config
eb40: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
eb50: 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 68 74 dat* "setup" "ht
eb60: 6d 6c 76 69 65 77 65 72 63 6d 64 22 29 29 29 0a mlviewercmd"))).
eb70: 20 20 20 20 28 69 66 20 68 74 6d 6c 76 69 65 77 (if htmlview
eb80: 65 72 63 6d 64 0a 09 28 73 79 73 74 65 6d 20 28 ercmd..(system (
eb90: 63 6f 6e 63 20 22 28 22 20 68 74 6d 6c 76 69 65 conc "(" htmlvie
eba0: 77 65 72 63 6d 64 20 22 20 22 20 6c 66 69 6c 65 wercmd " " lfile
ebb0: 6e 61 6d 65 20 22 20 29 20 26 22 29 29 20 0a 09 name " ) &")) ..
ebc0: 28 69 75 70 3a 73 65 6e 64 2d 75 72 6c 20 6c 66 (iup:send-url lf
ebd0: 69 6c 65 6e 61 6d 65 29 29 29 29 0a 0a 28 64 65 ilename))))..(de
ebe0: 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a fine (dashboard:
ebf0: 6d 6f 6e 69 74 6f 72 2d 63 68 61 6e 67 65 64 3f monitor-changed?
ec00: 20 63 6f 6d 6d 6f 6e 64 61 74 20 74 61 62 64 61 commondat tabda
ec10: 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e t). (let* ((run
ec20: 2d 75 70 64 61 74 65 2d 74 69 6d 65 20 28 63 75 -update-time (cu
ec30: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a rrent-seconds)).
ec40: 09 20 28 6d 6f 6e 69 74 6f 72 2d 64 62 2d 70 61 . (monitor-db-pa
ec50: 74 68 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 th (dboard:tabda
ec60: 74 2d 6d 6f 6e 69 74 6f 72 2d 64 62 2d 70 61 74 t-monitor-db-pat
ec70: 68 20 74 61 62 64 61 74 29 29 0a 09 20 28 6d 6f h tabdat)).. (mo
ec80: 6e 69 74 6f 72 2d 6d 6f 64 74 69 6d 65 20 28 69 nitor-modtime (i
ec90: 66 20 28 61 6e 64 20 6d 6f 6e 69 74 6f 72 2d 64 f (and monitor-d
eca0: 62 2d 70 61 74 68 20 28 63 6f 6d 6d 6f 6e 3a 66 b-path (common:f
ecb0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 6d 6f 6e 69 ile-exists? moni
ecc0: 74 6f 72 2d 64 62 2d 70 61 74 68 29 29 0a 09 09 tor-db-path))...
ecd0: 09 20 20 20 20 20 20 28 66 69 6c 65 2d 6d 6f 64 . (file-mod
ece0: 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 6d ification-time m
ecf0: 6f 6e 69 74 6f 72 2d 64 62 2d 70 61 74 68 29 0a onitor-db-path).
ed00: 09 09 09 20 20 20 20 20 20 2d 31 29 29 29 0a 20 ... -1))).
ed10: 20 20 20 28 69 66 20 28 61 6e 64 20 28 65 71 3f (if (and (eq?
ed20: 20 28 64 62 6f 61 72 64 3a 63 6f 6d 6d 6f 6e 64 (dboard:commond
ed30: 61 74 2d 63 75 72 72 2d 74 61 62 2d 6e 75 6d 20 at-curr-tab-num
ed40: 63 6f 6d 6d 6f 6e 64 61 74 29 20 30 29 0a 09 20 commondat) 0)..
ed50: 20 20 20 20 28 6f 72 20 28 3e 20 6d 6f 6e 69 74 (or (> monit
ed60: 6f 72 2d 6d 6f 64 74 69 6d 65 20 2a 6c 61 73 74 or-modtime *last
ed70: 2d 6d 6f 6e 69 74 6f 72 2d 75 70 64 61 74 65 2d -monitor-update-
ed80: 74 69 6d 65 2a 29 0a 09 09 20 28 3e 20 28 2d 20 time*)... (> (-
ed90: 72 75 6e 2d 75 70 64 61 74 65 2d 74 69 6d 65 20 run-update-time
eda0: 2a 6c 61 73 74 2d 6d 6f 6e 69 74 6f 72 2d 75 70 *last-monitor-up
edb0: 64 61 74 65 2d 74 69 6d 65 2a 29 20 35 29 29 29 date-time*) 5)))
edc0: 20 3b 3b 20 75 70 64 61 74 65 20 65 76 65 72 79 ;; update every
edd0: 20 31 2f 32 20 6d 69 6e 75 74 65 20 6a 75 73 74 1/2 minute just
ede0: 20 69 6e 20 63 61 73 65 0a 09 28 62 65 67 69 6e in case..(begin
edf0: 0a 09 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d .. (set! *last-
ee00: 6d 6f 6e 69 74 6f 72 2d 75 70 64 61 74 65 2d 74 monitor-update-t
ee10: 69 6d 65 2a 20 72 75 6e 2d 75 70 64 61 74 65 2d ime* run-update-
ee20: 74 69 6d 65 29 20 3b 3b 20 6d 6f 6e 69 74 6f 72 time) ;; monitor
ee30: 2d 6d 6f 64 74 69 6d 65 29 0a 09 20 20 23 74 29 -modtime).. #t)
ee40: 0a 09 23 66 29 29 29 0a 0a 3b 3b 20 44 4f 45 53 ..#f)))..;; DOES
ee50: 20 4e 4f 54 20 57 4f 52 4b 20 52 45 4c 49 41 42 NOT WORK RELIAB
ee60: 4c 59 20 57 49 54 48 20 2f 74 6d 70 20 57 41 4c LY WITH /tmp WAL
ee70: 20 6d 6f 64 65 20 66 69 6c 65 73 2e 20 54 69 6d mode files. Tim
ee80: 65 73 74 61 6d 70 73 20 6f 6e 6c 79 20 63 68 61 estamps only cha
ee90: 6e 67 65 20 77 68 65 6e 20 74 68 65 20 64 62 0a nge when the db.
eea0: 3b 3b 20 69 73 20 63 6c 6f 73 65 64 20 28 49 20 ;; is closed (I
eeb0: 74 68 69 6e 6b 29 2e 20 49 66 20 64 62 20 64 69 think). If db di
eec0: 72 20 73 74 61 72 74 73 20 77 69 74 68 20 2f 74 r starts with /t
eed0: 6d 70 20 61 6c 77 61 79 73 20 72 65 74 75 72 6e mp always return
eee0: 20 74 72 75 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 true.;;.(define
eef0: 20 28 64 61 73 68 62 6f 61 72 64 3a 64 61 74 61 (dashboard:data
ef00: 62 61 73 65 2d 63 68 61 6e 67 65 64 3f 20 63 6f base-changed? co
ef10: 6d 6d 6f 6e 64 61 74 20 74 61 62 64 61 74 20 23 mmondat tabdat #
ef20: 21 6b 65 79 20 28 63 6f 6e 74 65 78 74 2d 6b 65 !key (context-ke
ef30: 79 20 27 64 65 66 61 75 6c 74 29 29 0a 20 20 28 y 'default)). (
ef40: 6c 65 74 2a 20 28 28 72 75 6e 2d 75 70 64 61 74 let* ((run-updat
ef50: 65 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d e-time (current-
ef60: 73 65 63 6f 6e 64 73 29 29 0a 09 20 28 64 62 64 seconds)).. (dbd
ef70: 69 72 20 20 20 20 20 20 20 20 20 20 20 28 64 62 ir (db
ef80: 6f 61 72 64 3a 74 61 62 64 61 74 2d 64 62 64 69 oard:tabdat-dbdi
ef90: 72 20 74 61 62 64 61 74 29 29 0a 09 20 28 6d 6f r tabdat)).. (mo
efa0: 64 74 69 6d 65 20 20 20 20 20 20 20 20 20 28 64 dtime (d
efb0: 61 73 68 62 6f 61 72 64 3a 67 65 74 2d 79 6f 75 ashboard:get-you
efc0: 6e 67 65 73 74 2d 72 75 6e 2d 64 62 2d 6d 6f 64 ngest-run-db-mod
efd0: 2d 74 69 6d 65 20 64 62 64 69 72 29 29 0a 09 20 -time dbdir))..
efe0: 28 72 65 63 61 6c 63 20 20 20 20 20 20 20 20 20 (recalc
eff0: 20 28 64 61 73 68 62 6f 61 72 64 3a 72 65 63 61 (dashboard:reca
f000: 6c 63 20 6d 6f 64 74 69 6d 65 20 0a 09 09 09 09 lc modtime .....
f010: 09 20 20 20 20 28 64 62 6f 61 72 64 3a 63 6f 6d . (dboard:com
f020: 6d 6f 6e 64 61 74 2d 70 6c 65 61 73 65 2d 75 70 mondat-please-up
f030: 64 61 74 65 20 63 6f 6d 6d 6f 6e 64 61 74 29 20 date commondat)
f040: 0a 09 09 09 09 09 20 20 20 20 28 64 62 6f 61 72 ...... (dboar
f050: 64 3a 67 65 74 2d 6c 61 73 74 2d 64 62 2d 75 70 d:get-last-db-up
f060: 64 61 74 65 20 74 61 62 64 61 74 20 63 6f 6e 74 date tabdat cont
f070: 65 78 74 2d 6b 65 79 29 29 29 29 0a 20 20 20 20 ext-key)))).
f080: 3b 3b 20 28 64 62 6f 61 72 64 3a 74 61 62 64 61 ;; (dboard:tabda
f090: 74 2d 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 t-last-db-update
f0a0: 20 74 61 62 64 61 74 29 29 29 29 0a 20 20 20 20 tabdat)))).
f0b0: 28 69 66 20 72 65 63 61 6c 63 20 0a 09 28 64 62 (if recalc ..(db
f0c0: 6f 61 72 64 3a 73 65 74 2d 6c 61 73 74 2d 64 62 oard:set-last-db
f0d0: 2d 75 70 64 61 74 65 21 20 74 61 62 64 61 74 20 -update! tabdat
f0e0: 63 6f 6e 74 65 78 74 2d 6b 65 79 20 72 75 6e 2d context-key run-
f0f0: 75 70 64 61 74 65 2d 74 69 6d 65 29 29 0a 20 20 update-time)).
f100: 20 20 28 64 62 6f 61 72 64 3a 63 6f 6d 6d 6f 6e (dboard:common
f110: 64 61 74 2d 70 6c 65 61 73 65 2d 75 70 64 61 74 dat-please-updat
f120: 65 2d 73 65 74 21 20 63 6f 6d 6d 6f 6e 64 61 74 e-set! commondat
f130: 20 23 66 29 0a 20 20 20 20 72 65 63 61 6c 63 29 #f). recalc)
f140: 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 61 73 68 )..(define (dash
f150: 62 6f 61 72 64 3a 67 65 74 2d 79 6f 75 6e 67 65 board:get-younge
f160: 73 74 2d 72 75 6e 2d 64 62 2d 6d 6f 64 2d 74 69 st-run-db-mod-ti
f170: 6d 65 20 64 62 64 69 72 29 0a 20 20 28 68 61 6e me dbdir). (han
f180: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 dle-exceptions.
f190: 20 20 65 78 6e 0a 20 20 20 28 62 65 67 69 6e 0a exn. (begin.
f1a0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
f1b0: 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 2 *default-log
f1c0: 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a -port* "WARNING:
f1d0: 20 65 72 72 6f 72 20 69 6e 20 61 63 63 65 73 73 error in access
f1e0: 69 6e 67 20 64 61 74 61 62 61 73 65 73 20 69 6e ing databases in
f1f0: 20 67 65 74 2d 79 6f 75 6e 67 65 73 74 2d 72 75 get-youngest-ru
f200: 6e 2d 64 62 2d 6d 6f 64 2d 74 69 6d 65 3a 20 22 n-db-mod-time: "
f210: 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f ((condition-pro
f220: 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 perty-accessor '
f230: 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 exn 'message) ex
f240: 6e 29 20 22 20 64 62 2d 64 69 72 3d 22 64 62 64 n) " db-dir="dbd
f250: 69 72 29 0a 20 20 20 20 20 28 63 75 72 72 65 6e ir). (curren
f260: 74 2d 73 65 63 6f 6e 64 73 29 29 20 3b 3b 20 73 t-seconds)) ;; s
f270: 6f 6d 65 74 68 69 6e 67 20 77 65 6e 74 20 77 72 omething went wr
f280: 6f 6e 67 20 2d 20 6a 75 73 74 20 70 72 69 6e 74 ong - just print
f290: 20 61 6e 20 65 72 72 6f 72 20 61 6e 64 20 72 65 an error and re
f2a0: 74 75 72 6e 20 63 75 72 72 65 6e 74 2d 73 65 63 turn current-sec
f2b0: 6f 6e 64 73 0a 20 20 20 28 63 6f 6d 6d 6f 6e 3a onds. (common:
f2c0: 6d 61 78 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 max (map (lambda
f2d0: 20 28 66 69 6c 65 6e 29 0a 09 09 20 20 20 20 20 (filen)...
f2e0: 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 (file-modificat
f2f0: 69 6f 6e 2d 74 69 6d 65 20 66 69 6c 65 6e 29 29 ion-time filen))
f300: 0a 09 09 20 20 20 20 28 67 6c 6f 62 20 28 63 6f ... (glob (co
f310: 6e 63 20 64 62 64 69 72 20 22 2f 2a 2e 64 62 2a nc dbdir "/*.db*
f320: 22 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 "))))))..(define
f330: 20 28 64 62 6f 61 72 64 3a 67 65 74 2d 6c 61 73 (dboard:get-las
f340: 74 2d 64 62 2d 75 70 64 61 74 65 20 74 61 62 64 t-db-update tabd
f350: 61 74 20 63 6f 6e 74 65 78 74 29 0a 20 20 28 68 at context). (h
f360: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
f370: 66 61 75 6c 74 20 28 64 62 6f 61 72 64 3a 74 61 fault (dboard:ta
f380: 62 64 61 74 2d 6c 61 73 74 2d 64 62 2d 75 70 64 bdat-last-db-upd
f390: 61 74 65 20 74 61 62 64 61 74 29 20 63 6f 6e 74 ate tabdat) cont
f3a0: 65 78 74 20 30 29 29 0a 0a 28 64 65 66 69 6e 65 ext 0))..(define
f3b0: 20 28 64 62 6f 61 72 64 3a 73 65 74 2d 6c 61 73 (dboard:set-las
f3c0: 74 2d 64 62 2d 75 70 64 61 74 65 21 20 74 61 62 t-db-update! tab
f3d0: 64 61 74 20 63 6f 6e 74 65 78 74 20 6e 65 77 74 dat context newt
f3e0: 69 6d 65 29 0a 20 20 28 68 61 73 68 2d 74 61 62 ime). (hash-tab
f3f0: 6c 65 2d 73 65 74 21 20 28 64 62 6f 61 72 64 3a le-set! (dboard:
f400: 74 61 62 64 61 74 2d 6c 61 73 74 2d 64 62 2d 75 tabdat-last-db-u
f410: 70 64 61 74 65 20 74 61 62 64 61 74 29 20 63 6f pdate tabdat) co
f420: 6e 74 65 78 74 20 6e 65 77 74 69 6d 65 29 29 0a ntext newtime)).
f430: 0a 3b 3b 20 70 6f 69 6e 74 20 69 6e 73 69 64 65 .;; point inside
f440: 20 6c 69 6e 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 line.;;.(define
f450: 2d 69 6e 6c 69 6e 65 20 28 64 61 73 68 62 6f 61 -inline (dashboa
f460: 72 64 3a 70 78 2d 62 65 74 77 65 65 6e 20 70 78 rd:px-between px
f470: 20 6c 78 31 20 6c 78 32 29 0a 20 20 28 61 6e 64 lx1 lx2). (and
f480: 20 28 3c 20 6c 78 31 20 70 78 29 28 3e 20 6c 78 (< lx1 px)(> lx
f490: 32 20 70 78 29 29 29 0a 0a 28 64 65 66 69 6e 65 2 px)))..(define
f4a0: 20 28 64 61 73 68 62 6f 61 72 64 3a 72 65 63 61 (dashboard:reca
f4b0: 6c 63 20 6d 6f 64 74 69 6d 65 20 70 6c 65 61 73 lc modtime pleas
f4c0: 65 2d 75 70 64 61 74 65 2d 62 75 74 74 6f 6e 73 e-update-buttons
f4d0: 20 6c 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d last-db-update-
f4e0: 74 69 6d 65 29 0a 20 20 28 6f 72 20 70 6c 65 61 time). (or plea
f4f0: 73 65 2d 75 70 64 61 74 65 2d 62 75 74 74 6f 6e se-update-button
f500: 73 0a 20 20 20 20 20 20 28 61 6e 64 20 3b 3b 20 s. (and ;;
f510: 28 3e 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c (> (current-mill
f520: 69 73 65 63 6f 6e 64 73 29 28 2b 20 2a 6c 61 73 iseconds)(+ *las
f530: 74 2d 72 65 63 61 6c 63 2d 65 6e 64 65 64 2d 74 t-recalc-ended-t
f540: 69 6d 65 2a 20 31 35 30 29 29 20 3b 3b 20 63 61 ime* 150)) ;; ca
f550: 6e 27 74 20 75 73 65 20 74 68 69 73 20 2d 20 69 n't use this - i
f560: 74 20 6e 65 65 64 73 20 74 6f 20 62 65 20 74 61 t needs to be ta
f570: 62 20 73 70 65 63 69 66 69 63 0a 09 20 20 20 28 b specific.. (
f580: 3e 20 6d 6f 64 74 69 6d 65 20 28 2d 20 6c 61 73 > modtime (- las
f590: 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 6d 65 t-db-update-time
f5a0: 20 33 29 29 20 3b 3b 20 61 64 64 20 74 68 72 65 3)) ;; add thre
f5b0: 65 20 73 65 63 6f 6e 64 73 20 6f 66 20 6d 61 72 e seconds of mar
f5c0: 67 69 6e 0a 09 20 20 20 28 3e 20 28 63 75 72 72 gin.. (> (curr
f5d0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 28 2b 20 6c ent-seconds)(+ l
f5e0: 61 73 74 2d 64 62 2d 75 70 64 61 74 65 2d 74 69 ast-db-update-ti
f5f0: 6d 65 20 31 29 29 29 29 29 0a 0a me 1)))))..