0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 33 2c right 2006-2013,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 ==========..(use
01e0: 20 66 6f 72 6d 61 74 20 6e 75 6d 62 65 72 73 20 format numbers
01f0: 73 71 6c 2d 64 65 2d 6c 69 74 65 20 73 72 66 69 sql-de-lite srfi
0200: 2d 31 20 70 6f 73 69 78 20 72 65 67 65 78 20 72 -1 posix regex r
0210: 65 67 65 78 2d 63 61 73 65 20 73 72 66 69 2d 36 egex-case srfi-6
0220: 39 20 6e 61 6e 6f 6d 73 67 20 73 72 66 69 2d 31 9 nanomsg srfi-1
0230: 38 20 63 61 6c 6c 2d 77 69 74 68 2d 65 6e 76 69 8 call-with-envi
0240: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
0250: 73 29 0a 28 72 65 71 75 69 72 65 2d 6c 69 62 72 s).(require-libr
0260: 61 72 79 20 69 75 70 29 0a 28 69 6d 70 6f 72 74 ary iup).(import
0270: 20 28 70 72 65 66 69 78 20 69 75 70 20 69 75 70 (prefix iup iup
0280: 3a 29 29 0a 28 75 73 65 20 63 61 6e 76 61 73 2d :)).(use canvas-
0290: 64 72 61 77 29 0a 0a 28 64 65 63 6c 61 72 65 20 draw)..(declare
02a0: 28 75 73 65 73 20 6d 61 72 67 73 29 29 0a 28 64 (uses margs)).(d
02b0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 65 67 eclare (uses meg
02c0: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 29 0a atest-version)).
02d0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 67 (declare (uses g
02e0: 75 74 69 6c 73 29 29 0a 28 64 65 63 6c 61 72 65 utils)).(declare
02f0: 20 28 75 73 65 73 20 74 72 65 65 29 29 0a 28 64 (uses tree)).(d
0300: 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f 6e eclare (uses con
0310: 66 69 67 66 29 29 0a 28 64 65 63 6c 61 72 65 20 figf)).(declare
0320: 28 75 73 65 73 20 70 6f 72 74 6c 6f 67 67 65 72 (uses portlogger
0330: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
0340: 73 20 6b 65 79 73 29 29 0a 28 64 65 63 6c 61 72 s keys)).(declar
0350: 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 e (uses common))
0360: 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d ..(include "comm
0370: 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 on_records.scm")
0380: 0a 3b 3b 20 28 69 6e 63 6c 75 64 65 20 22 64 62 .;; (include "db
0390: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 3b _records.scm").;
03a0: 3b 20 28 69 6e 63 6c 75 64 65 20 22 6b 65 79 5f ; (include "key_
03b0: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a 28 records.scm")..(
03c0: 64 65 66 69 6e 65 20 68 65 6c 70 20 28 63 6f 6e define help (con
03d0: 63 20 0a 09 20 20 20 20 20 20 22 4d 65 67 61 74 c .. "Megat
03e0: 65 73 74 20 44 61 73 68 62 6f 61 72 64 2c 20 64 est Dashboard, d
03f0: 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 61 74 20 ocumentation at
0400: 68 74 74 70 3a 2f 2f 77 77 77 2e 6b 69 61 74 6f http://www.kiato
0410: 61 2e 63 6f 6d 2f 66 6f 73 73 69 6c 73 2f 6d 65 a.com/fossils/me
0420: 67 61 74 65 73 74 0a 20 20 76 65 72 73 69 6f 6e gatest. version
0430: 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 " megatest-vers
0440: 69 6f 6e 20 22 0a 20 20 6c 69 63 65 6e 73 65 20 ion ". license
0450: 47 50 4c 2c 20 43 6f 70 79 72 69 67 68 74 20 28 GPL, Copyright (
0460: 43 29 20 4d 61 74 74 20 57 65 6c 6c 61 6e 64 20 C) Matt Welland
0470: 32 30 31 31 0a 0a 55 73 61 67 65 3a 20 64 61 73 2011..Usage: das
0480: 68 62 6f 61 72 64 20 5b 6f 70 74 69 6f 6e 73 5d hboard [options]
0490: 0a 20 20 2d 68 20 20 20 20 20 20 20 20 20 20 20 . -h
04a0: 20 20 20 20 20 3a 20 74 68 69 73 20 68 65 6c 70 : this help
04b0: 0a 20 20 2d 67 72 6f 75 70 20 67 72 6f 75 70 6e . -group groupn
04c0: 61 6d 65 20 20 3a 20 64 69 73 70 6c 61 79 20 74 ame : display t
04d0: 68 69 73 20 67 72 6f 75 70 20 6f 66 20 61 72 65 his group of are
04e0: 61 73 0a 20 20 2d 74 65 73 74 20 74 65 73 74 69 as. -test testi
04f0: 64 20 20 20 20 20 20 3a 20 63 6f 6e 74 72 6f 6c d : control
0500: 20 74 65 73 74 20 69 64 65 6e 74 69 66 69 65 64 test identified
0510: 20 62 79 20 74 65 73 74 69 64 0a 20 20 2d 67 75 by testid. -gu
0520: 69 6d 6f 6e 69 74 6f 72 20 20 20 20 20 20 20 3a imonitor :
0530: 20 63 6f 6e 74 72 6f 6c 20 70 61 6e 65 6c 20 66 control panel f
0540: 6f 72 20 72 75 6e 73 0a 0a 4d 69 73 63 0a 20 20 or runs..Misc.
0550: 2d 72 6f 77 73 20 4e 20 20 20 20 20 20 20 20 20 -rows N
0560: 3a 20 73 65 74 20 6e 75 6d 62 65 72 20 6f 66 20 : set number of
0570: 72 6f 77 73 0a 22 29 29 0a 0a 3b 3b 20 70 72 6f rows."))..;; pro
0580: 63 65 73 73 20 61 72 67 73 0a 28 64 65 66 69 6e cess args.(defin
0590: 65 20 72 65 6d 61 72 67 73 20 28 61 72 67 73 3a e remargs (args:
05a0: 67 65 74 2d 61 72 67 73 20 0a 09 09 20 28 61 72 get-args ... (ar
05b0: 67 76 29 0a 09 09 20 28 6c 69 73 74 20 20 22 2d gv)... (list "-
05c0: 67 72 6f 75 70 22 20 3b 3b 20 64 69 73 70 6c 61 group" ;; displa
05d0: 79 20 74 68 69 73 20 67 72 6f 75 70 20 6f 66 20 y this group of
05e0: 61 72 65 61 73 0a 09 09 09 22 2d 64 65 62 75 67 areas...."-debug
05f0: 22 0a 09 09 09 29 20 0a 09 09 20 28 6c 69 73 74 "....) ... (list
0600: 20 20 22 2d 68 22 0a 09 09 09 22 2d 76 22 0a 09 "-h"...."-v"..
0610: 09 09 22 2d 71 22 0a 09 09 09 29 0a 09 09 20 61 .."-q"....)... a
0620: 72 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 09 20 rgs:arg-hash...
0630: 30 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 67 0))..(if (args:g
0640: 65 74 2d 61 72 67 20 22 2d 68 22 29 0a 20 20 20 et-arg "-h").
0650: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 28 70 (begin. (p
0660: 72 69 6e 74 20 68 65 6c 70 29 0a 20 20 20 20 20 rint help).
0670: 20 28 65 78 69 74 29 29 29 0a 0a 3b 3b 20 28 69 (exit)))..;; (i
0680: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
0690: 22 2d 68 6f 73 74 22 29 0a 3b 3b 20 20 20 20 20 "-host").;;
06a0: 28 62 65 67 69 6e 0a 3b 3b 20 20 20 20 20 20 20 (begin.;;
06b0: 28 73 65 74 21 20 28 63 6f 6d 6d 6f 6e 3a 67 65 (set! (common:ge
06c0: 74 2d 72 65 6d 6f 74 65 20 72 65 6d 6f 74 65 29 t-remote remote)
06d0: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 (string-split (
06e0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 68 args:get-arg "-h
06f0: 6f 73 74 22 20 22 3a 22 29 29 29 0a 3b 3b 20 20 ost" ":"))).;;
0700: 20 20 20 20 20 28 63 6c 69 65 6e 74 3a 6c 61 75 (client:lau
0710: 6e 63 68 29 29 0a 3b 3b 20 20 20 20 20 28 63 6c nch)).;; (cl
0720: 69 65 6e 74 3a 6c 61 75 6e 63 68 29 29 0a 0a 28 ient:launch))..(
0730: 64 65 66 69 6e 65 20 2a 72 75 6e 72 65 6d 6f 74 define *runremot
0740: 65 2a 20 23 66 29 0a 28 64 65 66 69 6e 65 20 2a e* #f).(define *
0750: 77 69 6e 64 6f 77 73 2a 20 28 6d 61 6b 65 2d 68 windows* (make-h
0760: 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 64 65 66 ash-table)).(def
0770: 69 6e 65 20 2a 63 68 61 6e 67 65 64 2d 6d 61 69 ine *changed-mai
0780: 6e 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 n* (make-hash-ta
0790: 62 6c 65 29 29 20 3b 3b 20 73 65 74 20 70 61 74 ble)) ;; set pat
07a0: 68 2f 2e 2e 2e 20 3d 3e 20 23 74 0a 28 64 65 66 h/... => #t.(def
07b0: 69 6e 65 20 2a 63 68 61 6e 67 65 64 2d 6d 75 74 ine *changed-mut
07c0: 65 78 2a 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 ex* (make-mutex)
07d0: 29 20 20 20 20 20 3b 3b 20 75 73 65 20 66 6f 72 ) ;; use for
07e0: 20 61 6c 6c 20 69 6e 63 6f 6d 69 6e 67 20 63 68 all incoming ch
07f0: 61 6e 67 65 20 72 65 71 75 65 73 74 73 0a 28 64 ange requests.(d
0800: 65 66 69 6e 65 20 2a 73 65 61 72 63 68 70 61 74 efine *searchpat
0810: 74 73 2a 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 ts* (make-hash
0820: 2d 74 61 62 6c 65 29 29 0a 0a 28 64 65 62 75 67 -table))..(debug
0830: 3a 73 65 74 75 70 29 0a 0a 28 64 65 66 69 6e 65 :setup)..(define
0840: 20 2a 74 69 6d 2a 20 28 69 75 70 3a 74 69 6d 65 *tim* (iup:time
0850: 72 29 29 0a 28 64 65 66 69 6e 65 20 2a 6f 72 64 r)).(define *ord
0860: 2a 20 23 66 29 0a 0a 28 69 75 70 3a 61 74 74 72 * #f)..(iup:attr
0870: 69 62 75 74 65 2d 73 65 74 21 20 2a 74 69 6d 2a ibute-set! *tim*
0880: 20 22 54 49 4d 45 22 20 33 30 30 29 0a 28 69 75 "TIME" 300).(iu
0890: 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 p:attribute-set!
08a0: 20 2a 74 69 6d 2a 20 22 52 55 4e 22 20 22 59 45 *tim* "RUN" "YE
08b0: 53 22 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 65 S")..(define (me
08c0: 73 73 61 67 65 2d 77 69 6e 64 6f 77 20 6d 73 67 ssage-window msg
08d0: 29 0a 20 20 28 69 75 70 3a 73 68 6f 77 0a 20 20 ). (iup:show.
08e0: 20 28 69 75 70 3a 64 69 61 6c 6f 67 0a 20 20 20 (iup:dialog.
08f0: 20 28 69 75 70 3a 76 62 6f 78 20 0a 20 20 20 20 (iup:vbox .
0900: 20 28 69 75 70 3a 6c 61 62 65 6c 20 6d 73 67 20 (iup:label msg
0910: 23 3a 6d 61 72 67 69 6e 20 22 34 30 78 34 30 22 #:margin "40x40"
0920: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
0930: 69 75 70 6c 69 73 74 62 6f 78 2d 66 69 6c 6c 2d iuplistbox-fill-
0940: 6c 69 73 74 20 6c 62 20 69 74 65 6d 73 20 2e 20 list lb items .
0950: 64 65 66 61 75 6c 74 29 0a 20 20 28 6c 65 74 20 default). (let
0960: 28 28 69 20 31 29 0a 09 28 73 65 6c 65 63 74 65 ((i 1)..(selecte
0970: 64 2d 69 74 65 6d 20 28 69 66 20 28 6e 75 6c 6c d-item (if (null
0980: 3f 20 64 65 66 61 75 6c 74 29 20 23 66 20 28 63 ? default) #f (c
0990: 61 72 20 64 65 66 61 75 6c 74 29 29 29 29 0a 20 ar default)))).
09a0: 20 20 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 (iup:attribut
09b0: 65 2d 73 65 74 21 20 6c 62 20 22 56 41 4c 55 45 e-set! lb "VALUE
09c0: 22 20 28 69 66 20 73 65 6c 65 63 74 65 64 2d 69 " (if selected-i
09d0: 74 65 6d 20 73 65 6c 65 63 74 65 64 2d 69 74 65 tem selected-ite
09e0: 6d 20 22 22 29 29 0a 20 20 20 20 28 66 6f 72 2d m "")). (for-
09f0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 69 74 each (lambda (it
0a00: 65 6d 29 0a 09 09 28 69 75 70 3a 61 74 74 72 69 em)...(iup:attri
0a10: 62 75 74 65 2d 73 65 74 21 20 6c 62 20 28 6e 75 bute-set! lb (nu
0a20: 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 69 29 20 mber->string i)
0a30: 69 74 65 6d 29 0a 09 09 28 69 66 20 73 65 6c 65 item)...(if sele
0a40: 63 74 65 64 2d 69 74 65 6d 0a 09 09 20 20 20 20 cted-item...
0a50: 28 69 66 20 28 65 71 75 61 6c 3f 20 73 65 6c 65 (if (equal? sele
0a60: 63 74 65 64 2d 69 74 65 6d 20 69 74 65 6d 29 0a cted-item item).
0a70: 09 09 09 28 69 75 70 3a 61 74 74 72 69 62 75 74 ...(iup:attribut
0a80: 65 2d 73 65 74 21 20 6c 62 20 22 56 41 4c 55 45 e-set! lb "VALUE
0a90: 22 20 69 74 65 6d 29 29 29 20 3b 3b 20 28 6e 75 " item))) ;; (nu
0aa0: 6d 62 65 72 2d 3e 73 74 72 69 6e 67 20 69 29 29 mber->string i))
0ab0: 29 29 0a 09 09 28 73 65 74 21 20 69 20 28 2b 20 ))...(set! i (+
0ac0: 69 20 31 29 29 29 0a 09 20 20 20 20 20 20 69 74 i 1))).. it
0ad0: 65 6d 73 29 0a 20 20 20 20 69 29 29 0a 0a 28 64 ems). i))..(d
0ae0: 65 66 69 6e 65 20 28 70 61 64 2d 6c 69 73 74 20 efine (pad-list
0af0: 6c 20 6e 29 28 61 70 70 65 6e 64 20 6c 20 28 6d l n)(append l (m
0b00: 61 6b 65 2d 6c 69 73 74 20 28 2d 20 6e 20 28 6c ake-list (- n (l
0b10: 65 6e 67 74 68 20 6c 29 29 29 29 29 0a 0a 0a 28 ength l)))))...(
0b20: 64 65 66 69 6e 65 20 28 6d 6b 73 74 72 20 2e 20 define (mkstr .
0b30: 78 29 0a 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 x). (string-int
0b40: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 6f ersperse (map co
0b50: 6e 63 20 78 29 20 22 2c 22 29 29 0a 0a 28 64 65 nc x) ","))..(de
0b60: 66 69 6e 65 20 28 75 70 64 61 74 65 2d 73 65 61 fine (update-sea
0b70: 72 63 68 20 78 20 76 61 6c 29 0a 20 20 28 68 61 rch x val). (ha
0b80: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 73 sh-table-set! *s
0b90: 65 61 72 63 68 70 61 74 74 73 2a 20 78 20 76 61 earchpatts* x va
0ba0: 6c 29 29 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d l))...;;========
0bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
0bf0: 3b 20 52 20 45 20 43 20 4f 20 52 20 44 20 53 0a ; R E C O R D S.
0c00: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0c40: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 ========..;; NOT
0c50: 45 3a 20 43 6f 6e 73 69 64 65 72 20 73 77 69 74 E: Consider swit
0c60: 63 68 69 6e 67 20 74 6f 20 64 65 66 73 74 72 75 ching to defstru
0c70: 63 74 2e 0a 0a 3b 3b 20 64 61 74 61 20 66 6f 72 ct...;; data for
0c80: 20 61 6e 20 61 72 65 61 20 28 72 65 67 72 65 73 an area (regres
0c90: 73 69 6f 6e 20 6f 72 20 74 65 73 74 73 75 69 74 sion or testsuit
0ca0: 65 29 0a 3b 3b 0a 28 64 65 66 69 6e 65 2d 72 65 e).;;.(define-re
0cb0: 63 6f 72 64 20 61 72 65 61 64 61 74 0a 20 20 6e cord areadat. n
0cc0: 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 20 20 ame
0cd0: 20 20 3b 3b 20 61 72 65 61 20 6e 61 6d 65 0a 20 ;; area name.
0ce0: 20 70 61 74 68 20 20 20 20 20 20 20 20 20 20 20 path
0cf0: 20 20 20 20 3b 3b 20 6d 74 20 72 75 6e 20 61 72 ;; mt run ar
0d00: 65 61 20 68 6f 6d 65 0a 20 20 63 6f 6e 66 69 67 ea home. config
0d10: 64 61 74 20 20 20 20 20 20 20 20 20 20 3b 3b 20 dat ;;
0d20: 6d 65 67 61 74 65 73 74 20 63 6f 6e 66 69 67 0a megatest config.
0d30: 20 20 64 65 6e 6f 69 73 65 20 20 20 20 20 20 20 denoise
0d40: 20 20 20 20 20 3b 3b 20 66 6f 63 61 6c 20 70 6f ;; focal po
0d50: 69 6e 74 20 66 6f 72 20 6e 6f 74 20 70 75 74 74 int for not putt
0d60: 69 6e 67 20 6f 75 74 20 73 61 6d 65 20 6d 65 73 ing out same mes
0d70: 73 61 67 65 73 20 6f 76 65 72 20 61 6e 64 20 6f sages over and o
0d80: 76 65 72 0a 20 20 63 6c 69 65 6e 74 2d 73 69 67 ver. client-sig
0d90: 6e 61 74 75 72 65 20 20 20 3b 3b 20 6b 65 79 20 nature ;; key
0da0: 66 6f 72 20 63 6c 69 65 6e 74 2d 73 65 72 76 65 for client-serve
0db0: 72 20 63 6f 6e 76 65 72 73 61 74 69 6f 6e 0a 20 r conversation.
0dc0: 20 72 65 6d 6f 74 65 20 20 20 20 20 20 20 20 20 remote
0dd0: 20 20 20 20 3b 3b 20 68 61 73 68 20 6f 66 20 61 ;; hash of a
0de0: 6c 6c 20 74 68 65 20 63 6c 69 65 6e 74 20 73 69 ll the client si
0df0: 64 65 20 63 6f 6e 6e 6e 65 63 74 69 6f 6e 73 0a de connnections.
0e00: 20 20 72 75 6e 2d 6b 65 79 73 20 20 20 20 20 20 run-keys
0e10: 20 20 20 20 20 3b 3b 20 74 61 72 67 65 74 20 6b ;; target k
0e20: 65 79 73 20 66 6f 72 20 74 68 69 73 20 61 72 65 eys for this are
0e30: 61 0a 20 20 72 75 6e 73 20 20 20 20 20 20 20 20 a. runs
0e40: 20 20 20 20 20 20 20 3b 3b 20 75 73 65 64 20 69 ;; used i
0e50: 6e 20 64 61 73 68 62 6f 61 72 64 2c 20 68 61 73 n dashboard, has
0e60: 68 20 6f 66 20 72 75 6e 2d 69 64 73 20 2d 3e 20 h of run-ids ->
0e70: 72 75 6e 64 61 74 0a 20 20 72 65 61 64 2d 6f 6e rundat. read-on
0e80: 6c 79 20 20 20 20 20 20 20 20 20 20 3b 3b 20 63 ly ;; c
0e90: 61 6e 20 49 20 77 72 69 74 65 20 74 6f 20 74 68 an I write to th
0ea0: 69 73 20 61 72 65 61 3f 0a 20 20 6d 6f 6e 69 74 is area?. monit
0eb0: 6f 72 64 62 20 20 20 20 20 20 20 20 20 20 3b 3b ordb ;;
0ec0: 20 64 62 20 68 61 6e 64 6c 65 20 66 6f 72 20 6d db handle for m
0ed0: 6f 6e 69 74 6f 72 2e 64 62 0a 20 20 6d 61 69 6e onitor.db. main
0ee0: 64 62 20 20 20 20 20 20 20 20 20 20 20 20 20 3b db ;
0ef0: 3b 20 64 62 20 68 61 6e 64 6c 65 20 66 6f 72 20 ; db handle for
0f00: 6d 61 69 6e 2e 64 62 0a 20 20 29 0a 0a 3b 3b 20 main.db. )..;;
0f10: 72 75 6e 64 61 74 2c 20 62 61 73 69 63 20 72 75 rundat, basic ru
0f20: 6e 20 64 61 74 61 0a 3b 3b 0a 28 64 65 66 69 6e n data.;;.(defin
0f30: 65 2d 72 65 63 6f 72 64 20 72 75 6e 64 61 74 0a e-record rundat.
0f40: 20 20 69 64 20 20 20 20 20 20 20 20 20 20 20 20 id
0f50: 20 20 20 20 20 3b 3b 20 74 68 65 20 72 75 6e 2d ;; the run-
0f60: 69 64 0a 20 20 74 61 72 67 65 74 20 20 20 20 20 id. target
0f70: 20 20 20 20 20 20 20 20 3b 3b 20 76 61 6c 31 2f ;; val1/
0f80: 76 61 6c 32 20 2e 2e 2e 20 63 6f 72 72 6f 73 70 val2 ... corrosp
0f90: 6f 6e 64 69 6e 67 20 74 6f 20 72 75 6e 2d 6b 65 onding to run-ke
0fa0: 79 73 20 69 6e 20 61 72 65 61 64 61 74 0a 20 20 ys in areadat.
0fb0: 72 75 6e 6e 61 6d 65 0a 20 20 73 74 61 74 65 20 runname. state
0fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
0fd0: 73 74 61 74 65 20 6f 66 20 74 68 65 20 72 75 6e state of the run
0fe0: 2c 20 73 79 6d 62 6f 6c 20 0a 20 20 73 74 61 74 , symbol . stat
0ff0: 75 73 20 20 20 20 20 20 20 20 20 20 20 20 20 3b us ;
1000: 3b 20 73 74 61 74 75 73 20 6f 66 20 74 68 65 20 ; status of the
1010: 72 75 6e 2c 20 73 79 6d 62 6f 6c 0a 20 20 65 76 run, symbol. ev
1020: 65 6e 74 2d 74 69 6d 65 20 20 20 20 20 20 20 20 ent-time
1030: 20 3b 3b 20 77 68 65 6e 20 74 68 65 20 72 75 6e ;; when the run
1040: 20 77 61 73 20 69 6e 69 74 69 61 74 65 64 0a 20 was initiated.
1050: 20 74 65 73 74 73 20 20 20 20 20 20 20 20 20 20 tests
1060: 20 20 20 20 3b 3b 20 68 61 73 68 20 6f 66 20 74 ;; hash of t
1070: 65 73 74 2d 69 64 20 2d 3e 20 74 65 73 74 64 61 est-id -> testda
1080: 74 2c 20 51 55 45 53 54 49 4f 4e 3a 20 73 65 70 t, QUESTION: sep
1090: 61 72 61 74 65 20 62 79 20 72 75 6e 2d 69 64 3f arate by run-id?
10a0: 0a 20 20 64 62 20 20 20 20 20 20 20 20 20 20 20 . db
10b0: 20 20 20 20 20 20 3b 3b 20 64 62 20 68 61 6e 64 ;; db hand
10c0: 6c 65 0a 20 20 29 0a 0a 3b 3b 20 74 65 73 74 64 le. )..;; testd
10d0: 61 74 2c 20 62 61 73 69 63 20 74 65 73 74 20 64 at, basic test d
10e0: 61 74 61 0a 28 64 65 66 69 6e 65 2d 72 65 63 6f ata.(define-reco
10f0: 72 64 20 74 65 73 74 64 61 74 0a 20 20 72 75 6e rd testdat. run
1100: 2d 69 64 20 20 20 20 20 20 20 20 20 20 20 20 20 -id
1110: 3b 3b 20 77 68 61 74 20 72 75 6e 20 69 73 20 74 ;; what run is t
1120: 68 69 73 20 66 72 6f 6d 0a 20 20 69 64 20 20 20 his from. id
1130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
1140: 20 74 65 73 74 20 69 64 0a 20 20 74 65 73 74 6e test id. testn
1150: 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 3b 3b ame ;;
1160: 20 74 65 73 74 20 6e 61 6d 65 0a 20 20 69 74 65 test name. ite
1170: 6d 70 61 74 68 20 20 20 20 20 20 20 20 20 20 20 mpath
1180: 3b 3b 20 69 74 65 6d 20 70 61 74 68 0a 20 20 73 ;; item path. s
1190: 74 61 74 65 20 20 20 20 20 20 20 20 20 20 20 20 tate
11a0: 20 20 3b 3b 20 74 65 73 74 20 73 74 61 74 65 2c ;; test state,
11b0: 20 73 79 6d 62 6f 6c 0a 20 20 73 74 61 74 75 73 symbol. status
11c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
11d0: 74 65 73 74 20 73 74 61 74 75 73 2c 20 73 79 6d test status, sym
11e0: 62 6f 6c 0a 20 20 65 76 65 6e 74 2d 74 69 6d 65 bol. event-time
11f0: 20 20 20 20 20 20 20 20 20 3b 3b 20 77 68 65 6e ;; when
1200: 20 74 68 65 20 74 65 73 74 20 73 74 61 72 74 65 the test starte
1210: 64 0a 20 20 64 75 72 61 74 69 6f 6e 20 20 20 20 d. duration
1220: 20 20 20 20 20 20 20 3b 3b 20 68 6f 77 20 6c 6f ;; how lo
1230: 6e 67 20 74 68 65 20 74 65 73 74 20 74 6f 6f 6b ng the test took
1240: 0a 20 20 29 0a 0a 3b 3b 20 67 65 6e 65 72 61 6c . )..;; general
1250: 20 64 61 74 61 20 66 6f 72 20 74 68 65 20 64 62 data for the db
1260: 6f 61 72 64 20 61 70 70 6c 69 63 61 74 69 6f 6e oard application
1270: 0a 3b 3b 0a 28 64 65 66 69 6e 65 2d 72 65 63 6f .;;.(define-reco
1280: 72 64 20 64 61 74 61 0a 20 20 63 66 67 64 61 74 rd data. cfgdat
1290: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
12a0: 64 61 74 61 20 66 72 6f 6d 20 7e 2f 2e 6d 65 67 data from ~/.meg
12b0: 61 74 65 73 74 2f 3c 67 72 6f 75 70 3e 2e 64 61 atest/<group>.da
12c0: 74 0a 20 20 61 72 65 61 73 20 20 20 20 20 20 20 t. areas
12d0: 20 20 20 20 20 20 20 3b 3b 20 68 61 73 68 20 6f ;; hash o
12e0: 66 20 61 72 65 61 6e 61 6d 65 20 2d 3e 20 61 72 f areaname -> ar
12f0: 65 61 2d 72 65 63 0a 20 20 63 75 72 72 65 6e 74 ea-rec. current
1300: 2d 77 69 6e 64 6f 77 2d 69 64 20 20 3b 3b 20 0a -window-id ;; .
1310: 20 20 63 75 72 72 65 6e 74 2d 74 61 62 2d 69 64 current-tab-id
1320: 20 20 20 20 20 3b 3b 20 0a 20 20 75 70 64 61 74 ;; . updat
1330: 65 2d 6e 65 65 64 65 64 20 20 20 20 20 20 3b 3b e-needed ;;
1340: 20 66 6c 61 67 20 74 6f 20 69 6e 64 69 63 61 74 flag to indicat
1350: 65 20 74 68 61 74 20 74 68 65 20 74 61 62 20 70 e that the tab p
1360: 6f 69 6e 74 65 64 20 74 6f 20 62 79 20 63 75 72 ointed to by cur
1370: 72 65 6e 74 20 74 61 62 20 69 64 20 6e 65 65 64 rent tab id need
1380: 73 20 72 65 66 72 65 73 68 69 6e 67 20 69 6d 6d s refreshing imm
1390: 65 64 69 61 74 65 6c 79 0a 20 20 74 61 62 73 20 ediately. tabs
13a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
13b0: 20 68 61 73 68 20 6f 66 20 74 61 62 2d 69 64 20 hash of tab-id
13c0: 2d 3e 20 61 72 65 61 6e 61 6d 65 20 28 3f 3f 29 -> areaname (??)
13d0: 20 73 68 6f 75 6c 64 20 62 65 20 6f 66 20 74 79 should be of ty
13e0: 70 65 20 22 74 61 62 22 0a 20 20 29 0a 0a 3b 3b pe "tab". )..;;
13f0: 20 61 6c 6c 20 74 68 65 20 63 6f 6d 70 6f 6e 65 all the compone
1400: 6e 74 73 20 6f 66 20 61 6e 20 61 72 65 61 20 64 nts of an area d
1410: 69 73 70 6c 61 79 2c 20 61 6c 6c 20 66 69 74 73 isplay, all fits
1420: 20 69 6e 74 6f 20 61 20 74 61 62 20 62 75 74 0a into a tab but.
1430: 3b 3b 20 70 61 72 74 73 20 6d 61 79 20 62 65 20 ;; parts may be
1440: 73 77 61 70 70 65 64 20 69 6e 2f 6f 75 74 20 61 swapped in/out a
1450: 73 20 6e 65 65 64 65 64 0a 3b 3b 0a 28 64 65 66 s needed.;;.(def
1460: 69 6e 65 2d 72 65 63 6f 72 64 20 74 61 62 0a 20 ine-record tab.
1470: 20 74 72 65 65 0a 20 20 6d 61 74 72 69 78 20 20 tree. matrix
1480: 20 20 3b 3b 20 74 68 65 20 73 70 72 65 61 64 73 ;; the spreads
1490: 68 65 65 74 20 0a 20 20 61 72 65 61 64 61 74 20 heet . areadat
14a0: 20 20 3b 3b 20 74 68 65 20 6f 6e 65 2d 73 74 72 ;; the one-str
14b0: 75 63 74 75 72 65 20 28 6f 6e 65 20 64 61 79 20 ucture (one day
14c0: 64 62 73 74 72 75 63 74 20 77 69 6c 6c 20 62 65 dbstruct will be
14d0: 20 70 75 74 20 69 6e 20 68 65 72 65 29 0a 20 20 put in here).
14e0: 76 69 65 77 2d 70 61 74 68 20 3b 3b 20 3c 74 61 view-path ;; <ta
14f0: 72 67 65 74 2f 70 61 74 68 3e 2f 3c 72 75 6e 6e rget/path>/<runn
1500: 61 6d 65 3e 2f 2e 2e 2e 0a 20 20 76 69 65 77 2d ame>/.... view-
1510: 74 79 70 65 20 3b 3b 20 73 74 61 6e 64 61 72 64 type ;; standard
1520: 2c 20 65 74 63 2e 0a 20 20 63 6f 6e 74 72 6f 6c , etc.. control
1530: 73 20 20 3b 3b 20 74 68 65 20 63 6f 6e 74 72 6f s ;; the contro
1540: 6c 73 0a 20 20 64 61 74 61 20 20 20 20 20 20 3b ls. data ;
1550: 3b 20 61 6c 6c 20 74 68 65 20 64 61 74 61 20 6b ; all the data k
1560: 65 70 74 20 69 6e 20 73 79 6e 63 20 77 69 74 68 ept in sync with
1570: 20 64 62 0a 20 20 66 69 6c 74 65 72 73 20 20 20 db. filters
1580: 3b 3b 20 75 73 65 72 20 66 69 6c 74 65 72 73 2c ;; user filters,
1590: 20 61 6c 69 73 74 20 6e 61 6d 65 20 2d 3e 20 66 alist name -> f
15a0: 69 6c 74 65 72 20 72 65 63 6f 72 64 2c 20 65 76 ilter record, ev
15b0: 65 6e 74 75 61 6c 6c 79 20 73 74 6f 72 65 20 74 entually store t
15c0: 68 65 73 65 20 69 6e 20 7e 2f 2e 6d 65 67 61 74 hese in ~/.megat
15d0: 65 73 74 2f 3c 67 72 6f 75 70 3e 2e 64 61 74 3f est/<group>.dat?
15e0: 0a 20 20 72 75 6e 2d 69 64 20 20 20 20 3b 3b 20 . run-id ;;
15f0: 74 68 65 20 63 75 72 72 65 6e 74 20 72 75 6e 2d the current run-
1600: 69 64 0a 20 20 74 65 73 74 2d 69 64 73 20 20 3b id. test-ids ;
1610: 3b 20 74 68 65 20 63 75 72 72 65 6e 74 20 74 65 ; the current te
1620: 73 74 20 69 64 20 68 61 73 68 2c 20 72 75 6e 2d st id hash, run-
1630: 69 64 20 3d 3e 20 74 65 73 74 2d 69 64 0a 20 20 id => test-id.
1640: 63 6f 6d 6d 61 6e 64 20 20 20 3b 3b 20 74 68 65 command ;; the
1650: 20 63 6f 6d 6d 61 6e 64 20 66 72 6f 6d 20 74 68 command from th
1660: 65 20 65 6e 74 72 79 20 66 69 65 6c 64 0a 20 20 e entry field.
1670: 68 65 61 64 65 72 73 20 20 20 3b 3b 20 68 61 73 headers ;; has
1680: 68 20 6f 66 20 68 65 61 64 65 72 20 20 2d 3e 20 h of header ->
1690: 63 6f 6c 6e 75 6d 0a 20 20 72 6f 77 73 20 20 20 colnum. rows
16a0: 20 20 20 3b 3b 20 68 61 73 68 20 6f 66 20 72 6f ;; hash of ro
16b0: 77 6e 61 6d 65 20 2d 3e 20 72 6f 77 6e 75 6d 0a wname -> rownum.
16c0: 20 20 29 0a 0a 28 64 65 66 69 6e 65 2d 72 65 63 )..(define-rec
16d0: 6f 72 64 20 66 69 6c 74 65 72 0a 20 20 74 61 72 ord filter. tar
16e0: 67 65 74 20 20 20 20 3b 3b 20 68 61 73 68 20 6f get ;; hash o
16f0: 66 20 77 69 64 67 65 74 73 20 66 6f 72 20 74 68 f widgets for th
1700: 65 20 74 61 72 67 65 74 0a 20 20 72 75 6e 6e 61 e target. runna
1710: 6d 65 20 20 20 3b 3b 20 74 68 65 20 72 75 6e 6e me ;; the runn
1720: 61 6d 65 20 77 69 64 67 65 74 0a 20 20 74 65 73 ame widget. tes
1730: 74 70 61 74 74 20 20 3b 3b 20 74 68 65 20 74 65 tpatt ;; the te
1740: 73 74 70 61 74 74 20 77 69 64 67 65 74 0a 20 20 stpatt widget.
1750: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
1760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 44 ===========.;; D
17a0: 20 42 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d B.;;===========
17b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
17c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
17d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
17e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
17f0: 54 68 65 73 65 20 61 72 65 20 61 6c 6c 20 75 73 These are all us
1800: 69 6e 67 20 73 71 6c 2d 64 65 2d 6c 69 74 65 20 ing sql-de-lite
1810: 61 6e 64 20 69 6e 64 65 70 65 6e 64 65 6e 74 20 and independent
1820: 6f 66 20 61 72 65 61 20 73 6f 20 63 61 6e 6e 6f of area so canno
1830: 74 20 75 73 65 20 73 74 75 66 66 20 0a 3b 3b 20 t use stuff .;;
1840: 66 72 6f 6d 20 64 62 2e 73 63 6d 0a 0a 3b 3b 20 from db.scm..;;
1850: 4e 42 2f 2f 20 72 75 6e 2d 69 64 3d 23 66 20 3d NB// run-id=#f =
1860: 3e 20 72 65 74 75 72 6e 20 64 62 64 69 72 20 6f > return dbdir o
1870: 6e 6c 79 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 nly.;;.(define (
1880: 61 72 65 61 64 62 3a 64 62 66 69 6c 65 2d 70 61 areadb:dbfile-pa
1890: 74 68 20 61 72 65 61 64 61 74 20 72 75 6e 2d 69 th areadat run-i
18a0: 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 66 67 d). (let* ((cfg
18b0: 64 61 74 20 20 28 61 72 65 61 64 61 74 2d 63 6f dat (areadat-co
18c0: 6e 66 69 67 64 61 74 20 61 72 65 61 64 61 74 29 nfigdat areadat)
18d0: 29 0a 09 20 28 64 62 64 69 72 20 20 20 28 6f 72 ).. (dbdir (or
18e0: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
18f0: 20 63 66 67 64 61 74 20 22 73 65 74 75 70 22 20 cfgdat "setup"
1900: 22 64 62 64 69 72 22 29 0a 09 09 20 20 20 20 20 "dbdir")...
1910: 20 28 63 6f 6e 63 20 28 63 6f 6e 66 69 67 66 3a (conc (configf:
1920: 6c 6f 6f 6b 75 70 20 63 66 67 64 61 74 20 22 73 lookup cfgdat "s
1930: 65 74 75 70 22 20 22 6c 69 6e 6b 74 72 65 65 22 etup" "linktree"
1940: 29 20 22 2f 2e 64 62 22 29 29 29 0a 09 20 28 66 ) "/.db"))).. (f
1950: 6e 61 6d 65 20 20 20 28 69 66 20 72 75 6e 2d 69 name (if run-i
1960: 64 0a 09 09 20 20 20 20 20 20 28 63 61 73 65 20 d... (case
1970: 72 75 6e 2d 69 64 0a 09 09 09 28 28 2d 31 29 20 run-id....((-1)
1980: 22 6d 6f 6e 69 74 6f 72 2e 64 62 22 29 0a 09 09 "monitor.db")...
1990: 09 28 28 30 29 20 22 6d 61 69 6e 2e 64 62 22 29 .((0) "main.db")
19a0: 0a 09 09 09 28 65 6c 73 65 20 28 63 6f 6e 63 20 ....(else (conc
19b0: 72 75 6e 2d 69 64 20 22 2e 64 62 22 29 29 29 0a run-id ".db"))).
19c0: 09 09 20 20 20 20 20 20 23 66 29 29 29 0a 20 20 .. #f))).
19d0: 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 (handle-except
19e0: 69 6f 6e 73 0a 20 20 20 20 20 65 78 6e 0a 20 20 ions. exn.
19f0: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
1a00: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
1a10: 22 45 52 52 4f 52 3a 20 43 6f 75 6c 64 6e 27 74 "ERROR: Couldn't
1a20: 20 63 72 65 61 74 65 20 70 61 74 68 20 74 6f 20 create path to
1a30: 22 20 64 62 64 69 72 29 0a 20 20 20 20 20 20 20 " dbdir).
1a40: 28 65 78 69 74 20 31 29 29 0a 20 20 20 20 20 28 (exit 1)). (
1a50: 69 66 20 28 6e 6f 74 20 28 64 69 72 65 63 74 6f if (not (directo
1a60: 72 79 3f 20 64 62 64 69 72 29 29 28 63 72 65 61 ry? dbdir))(crea
1a70: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 64 62 64 te-directory dbd
1a80: 69 72 20 23 74 29 29 29 0a 20 20 20 20 28 69 66 ir #t))). (if
1a90: 20 66 6e 61 6d 65 0a 09 28 63 6f 6e 63 20 64 62 fname..(conc db
1aa0: 64 69 72 20 22 2f 22 20 66 6e 61 6d 65 29 0a 09 dir "/" fname)..
1ab0: 64 62 64 69 72 29 29 29 0a 0a 3b 3b 20 2d 31 20 dbdir)))..;; -1
1ac0: 3d 3e 20 6d 6f 6e 69 74 6f 72 2e 64 62 0a 3b 3b => monitor.db.;;
1ad0: 20 20 30 20 3d 3e 20 6d 61 69 6e 2e 64 62 0a 3b 0 => main.db.;
1ae0: 3b 20 3e 31 20 3d 3e 20 3c 72 75 6e 2d 69 64 3e ; >1 => <run-id>
1af0: 2e 64 62 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 .db.;;.(define (
1b00: 61 72 65 61 64 62 3a 6f 70 65 6e 20 61 72 65 61 areadb:open area
1b10: 64 61 74 20 72 75 6e 2d 69 64 29 0a 20 20 28 6c dat run-id). (l
1b20: 65 74 2a 20 28 28 72 75 6e 73 20 20 20 28 61 72 et* ((runs (ar
1b30: 65 61 64 61 74 2d 72 75 6e 73 20 61 72 65 61 64 eadat-runs aread
1b40: 61 74 29 29 0a 09 20 28 72 75 6e 64 61 74 20 28 at)).. (rundat (
1b50: 69 66 20 28 3e 20 72 75 6e 2d 69 64 20 30 29 20 if (> run-id 0)
1b60: 3b 3b 20 69 74 20 69 73 20 61 20 72 75 6e 0a 09 ;; it is a run..
1b70: 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c . (hash-tabl
1b80: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 72 75 e-ref/default ru
1b90: 6e 73 20 72 75 6e 2d 69 64 20 23 66 29 0a 09 09 ns run-id #f)...
1ba0: 20 20 20 20 20 23 66 29 29 0a 09 20 28 64 62 20 #f)).. (db
1bb0: 20 20 20 20 28 63 61 73 65 20 72 75 6e 2d 69 64 (case run-id
1bc0: 20 3b 3b 20 69 66 20 61 6c 72 65 61 64 79 20 6f ;; if already o
1bd0: 70 65 6e 65 64 2c 20 67 65 74 20 74 68 65 20 64 pened, get the d
1be0: 62 20 61 6e 64 20 72 65 74 75 72 6e 20 69 74 0a b and return it.
1bf0: 09 09 20 20 20 28 28 2d 31 29 20 28 61 72 65 61 .. ((-1) (area
1c00: 64 61 74 2d 6d 6f 6e 69 74 6f 72 64 62 20 61 72 dat-monitordb ar
1c10: 65 61 64 61 74 29 29 0a 09 09 20 20 20 28 28 30 eadat))... ((0
1c20: 29 20 20 28 61 72 65 61 64 61 74 2d 6d 61 69 6e ) (areadat-main
1c30: 64 62 20 20 20 20 61 72 65 61 64 61 74 29 29 0a db areadat)).
1c40: 09 09 20 20 20 28 65 6c 73 65 20 28 69 66 20 72 .. (else (if r
1c50: 75 6e 64 61 74 0a 09 09 09 20 20 20 20 20 28 72 undat.... (r
1c60: 75 6e 64 61 74 2d 64 62 20 72 75 6e 64 61 74 29 undat-db rundat)
1c70: 0a 09 09 09 20 20 20 20 20 23 66 29 29 29 29 29 .... #f)))))
1c80: 0a 20 20 20 20 28 69 66 20 64 62 0a 09 64 62 20 . (if db..db
1c90: 3b 3b 20 6d 65 72 65 6c 79 20 72 65 74 75 72 6e ;; merely return
1ca0: 20 74 68 65 20 61 6c 72 65 61 64 79 20 6f 70 65 the already ope
1cb0: 6e 65 64 20 64 62 0a 09 28 6c 65 74 2a 20 28 28 ned db..(let* ((
1cc0: 64 62 66 69 6c 65 20 28 61 72 65 61 64 62 3a 64 dbfile (areadb:d
1cd0: 62 66 69 6c 65 2d 70 61 74 68 20 61 72 65 61 64 bfile-path aread
1ce0: 61 74 20 72 75 6e 2d 69 64 29 29 20 3b 3b 20 6e at run-id)) ;; n
1cf0: 6f 74 20 61 6c 72 65 61 64 79 20 6f 70 65 6e 65 ot already opene
1d00: 64 2c 20 73 6f 20 6f 70 65 6e 20 69 74 0a 09 20 d, so open it..
1d10: 20 20 20 20 20 20 28 64 62 20 20 20 20 20 28 69 (db (i
1d20: 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 f (file-exists?
1d30: 64 62 66 69 6c 65 29 0a 09 09 09 20 20 20 28 6f dbfile).... (o
1d40: 70 65 6e 2d 64 61 74 61 62 61 73 65 20 64 62 66 pen-database dbf
1d50: 69 6c 65 29 0a 09 09 09 20 20 20 28 62 65 67 69 ile).... (begi
1d60: 6e 0a 09 09 09 20 20 20 20 20 28 64 65 62 75 67 n.... (debug
1d70: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
1d80: 20 49 20 77 61 73 20 61 73 6b 65 64 20 74 6f 20 I was asked to
1d90: 6f 70 65 6e 20 22 20 64 62 66 69 6c 65 20 22 2c open " dbfile ",
1da0: 20 62 75 74 20 66 69 6c 65 20 64 6f 65 73 20 6e but file does n
1db0: 6f 74 20 65 78 69 73 74 20 6f 72 20 69 73 20 6e ot exist or is n
1dc0: 6f 74 20 72 65 61 64 61 62 6c 65 2e 22 29 0a 09 ot readable.")..
1dd0: 09 09 20 20 20 20 20 23 66 29 29 29 29 0a 09 20 .. #f))))..
1de0: 20 28 63 61 73 65 20 72 75 6e 2d 69 64 0a 09 20 (case run-id..
1df0: 20 20 20 28 28 2d 31 29 28 61 72 65 61 64 61 74 ((-1)(areadat
1e00: 2d 6d 6f 6e 69 74 6f 72 64 62 2d 73 65 74 21 20 -monitordb-set!
1e10: 61 72 65 61 64 61 74 20 64 62 29 29 0a 09 20 20 areadat db))..
1e20: 20 20 28 28 30 29 20 28 61 72 65 61 64 61 74 2d ((0) (areadat-
1e30: 6d 61 69 6e 64 62 2d 73 65 74 21 20 20 20 20 61 maindb-set! a
1e40: 72 65 61 64 61 74 20 64 62 29 29 0a 09 20 20 20 readat db))..
1e50: 20 28 65 6c 73 65 20 28 72 75 6e 64 61 74 2d 64 (else (rundat-d
1e60: 62 2d 73 65 74 21 20 20 20 20 20 20 20 20 72 75 b-set! ru
1e70: 6e 64 61 74 20 20 64 62 29 29 29 0a 09 20 20 64 ndat db))).. d
1e80: 62 29 29 29 29 0a 0a 3b 3b 20 70 6f 70 75 6c 61 b))))..;; popula
1e90: 74 65 20 74 68 65 20 61 72 65 61 64 61 74 20 74 te the areadat t
1ea0: 65 73 74 73 20 69 6e 66 6f 2c 20 64 6f 65 73 20 ests info, does
1eb0: 4e 4f 54 20 66 69 6c 6c 20 74 68 65 20 74 65 73 NOT fill the tes
1ec0: 74 73 20 64 61 74 61 20 69 74 73 65 6c 66 20 75 ts data itself u
1ed0: 6e 6c 65 73 73 20 61 73 6b 65 64 0a 3b 3b 0a 28 nless asked.;;.(
1ee0: 64 65 66 69 6e 65 20 28 61 72 65 61 64 62 3a 70 define (areadb:p
1ef0: 6f 70 75 6c 61 74 65 2d 72 75 6e 2d 69 6e 66 6f opulate-run-info
1f00: 20 61 72 65 61 64 61 74 29 0a 20 20 28 6c 65 74 areadat). (let
1f10: 2a 20 28 28 72 75 6e 73 20 20 20 28 6f 72 20 28 * ((runs (or (
1f20: 61 72 65 61 64 61 74 2d 72 75 6e 73 20 61 72 65 areadat-runs are
1f30: 61 64 61 74 29 20 28 6d 61 6b 65 2d 68 61 73 68 adat) (make-hash
1f40: 2d 74 61 62 6c 65 29 29 29 0a 09 20 28 6b 65 79 -table))).. (key
1f50: 73 20 20 20 28 61 72 65 61 64 61 74 2d 72 75 6e s (areadat-run
1f60: 2d 6b 65 79 73 20 61 72 65 61 64 61 74 29 29 0a -keys areadat)).
1f70: 09 20 28 6d 61 69 6e 64 62 20 28 61 72 65 61 64 . (maindb (aread
1f80: 62 3a 6f 70 65 6e 20 61 72 65 61 64 61 74 20 30 b:open areadat 0
1f90: 29 29 29 0a 20 20 20 20 28 71 75 65 72 79 20 28 ))). (query (
1fa0: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 28 6c 61 for-each-row (la
1fb0: 6d 62 64 61 20 28 72 6f 77 29 0a 09 09 09 20 20 mbda (row)....
1fc0: 20 28 6c 65 74 20 28 28 69 64 20 20 28 6c 69 73 (let ((id (lis
1fd0: 74 2d 72 65 66 20 72 6f 77 20 30 29 29 0a 09 09 t-ref row 0))...
1fe0: 09 09 20 28 64 61 74 20 28 61 70 70 6c 79 20 6d .. (dat (apply m
1ff0: 61 6b 65 2d 72 75 6e 64 61 74 20 28 61 70 70 65 ake-rundat (appe
2000: 6e 64 20 72 6f 77 20 28 6c 69 73 74 20 23 66 20 nd row (list #f
2010: 23 66 29 29 29 29 29 20 3b 3b 20 61 64 64 20 70 #f))))) ;; add p
2020: 6c 61 63 65 68 6f 6c 64 65 72 73 20 66 6f 72 20 laceholders for
2030: 74 65 73 74 73 20 61 6e 64 20 64 62 0a 09 09 09 tests and db....
2040: 20 20 20 20 20 28 70 72 69 6e 74 20 72 6f 77 29 (print row)
2050: 0a 09 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 .... (hash-t
2060: 61 62 6c 65 2d 73 65 74 21 20 72 75 6e 73 20 69 able-set! runs i
2070: 64 20 64 61 74 29 29 29 29 0a 09 20 20 20 28 73 d dat)))).. (s
2080: 71 6c 20 6d 61 69 6e 64 62 20 28 63 6f 6e 63 20 ql maindb (conc
2090: 22 53 45 4c 45 43 54 20 69 64 2c 22 0a 09 09 09 "SELECT id,"....
20a0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 (string-int
20b0: 65 72 73 70 65 72 73 65 20 6b 65 79 73 20 22 7c ersperse keys "|
20c0: 7c 27 2f 27 7c 7c 22 29 0a 09 09 09 20 20 20 20 |'/'||")....
20d0: 20 22 2c 72 75 6e 6e 61 6d 65 2c 73 74 61 74 65 ",runname,state
20e0: 2c 73 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 ,status,event_ti
20f0: 6d 65 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 me FROM runs WHE
2100: 52 45 20 73 74 61 74 65 20 21 3d 20 27 64 65 6c RE state != 'del
2110: 65 74 65 64 27 3b 22 29 29 29 0a 20 20 20 20 61 eted';"))). a
2120: 72 65 61 64 61 74 29 29 0a 0a 3b 3b 20 67 69 76 readat))..;; giv
2130: 65 6e 20 61 6e 20 61 72 65 61 64 61 74 20 61 6e en an areadat an
2140: 64 20 74 61 72 67 65 74 2f 72 75 6e 6e 61 6d 65 d target/runname
2150: 20 70 61 74 74 20 66 69 6c 6c 20 75 70 20 72 75 patt fill up ru
2160: 6e 73 20 64 61 74 61 0a 3b 3b 0a 3b 3b 20 3f 3f ns data.;;.;; ??
2170: 3f 3f 3f 2f 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 ???/..;; given a
2180: 20 6c 69 73 74 20 6f 66 20 72 75 6e 2d 69 64 73 list of run-ids
2190: 20 72 65 66 72 65 73 68 2f 72 65 74 72 69 65 76 refresh/retriev
21a0: 65 20 72 75 6e 73 20 64 61 74 61 20 69 6e 74 6f e runs data into
21b0: 20 61 72 65 61 64 61 74 0a 3b 3b 0a 28 64 65 66 areadat.;;.(def
21c0: 69 6e 65 20 28 61 72 65 61 64 62 3a 66 69 6c 6c ine (areadb:fill
21d0: 2d 74 65 73 74 73 20 61 72 65 61 64 61 74 20 23 -tests areadat #
21e0: 21 6b 65 79 20 28 72 75 6e 2d 69 64 73 20 23 66 !key (run-ids #f
21f0: 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e )). (let* ((run
2200: 73 20 20 20 28 6f 72 20 28 61 72 65 61 64 61 74 s (or (areadat
2210: 2d 72 75 6e 73 20 61 72 65 61 64 61 74 29 20 28 -runs areadat) (
2220: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
2230: 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 ))). (for-eac
2240: 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 h. (lambda (
2250: 72 75 6e 2d 69 64 29 0a 20 20 20 20 20 20 20 28 run-id). (
2260: 6c 65 74 2a 20 28 28 72 75 6e 64 61 74 20 28 68 let* ((rundat (h
2270: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
2280: 66 61 75 6c 74 20 72 75 6e 73 20 72 75 6e 2d 69 fault runs run-i
2290: 64 20 23 66 29 29 0a 09 20 20 20 20 20 20 28 74 d #f)).. (t
22a0: 65 73 74 73 20 20 28 69 66 20 28 61 6e 64 20 72 ests (if (and r
22b0: 75 6e 64 61 74 0a 09 09 09 20 20 20 20 20 20 20 undat....
22c0: 28 72 75 6e 64 61 74 2d 74 65 73 74 73 20 72 75 (rundat-tests ru
22d0: 6e 64 61 74 29 29 20 3b 3b 20 72 65 2d 75 73 65 ndat)) ;; re-use
22e0: 20 65 78 69 73 74 69 6e 67 20 68 61 73 68 20 74 existing hash t
22f0: 61 62 6c 65 3f 0a 09 09 09 20 20 28 72 75 6e 64 able?.... (rund
2300: 61 74 2d 74 65 73 74 73 20 72 75 6e 64 61 74 29 at-tests rundat)
2310: 0a 09 09 09 20 20 28 6c 65 74 20 28 28 68 74 20 .... (let ((ht
2320: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
2330: 29 29 29 0a 09 09 09 20 20 20 20 28 72 75 6e 64 ))).... (rund
2340: 61 74 2d 74 65 73 74 73 2d 73 65 74 21 20 72 75 at-tests-set! ru
2350: 6e 64 61 74 20 68 74 29 0a 09 09 09 20 20 20 20 ndat ht)....
2360: 68 74 29 29 29 0a 09 20 20 20 20 20 20 28 72 75 ht))).. (ru
2370: 6e 64 62 20 20 28 61 72 65 61 64 62 3a 6f 70 65 ndb (areadb:ope
2380: 6e 20 61 72 65 61 64 61 74 20 72 75 6e 2d 69 64 n areadat run-id
2390: 29 29 29 0a 09 20 28 71 75 65 72 79 20 28 66 6f ))).. (query (fo
23a0: 72 2d 65 61 63 68 2d 72 6f 77 20 28 6c 61 6d 62 r-each-row (lamb
23b0: 64 61 20 28 72 6f 77 29 0a 09 09 09 09 28 6c 65 da (row).....(le
23c0: 74 2a 20 28 28 69 64 20 20 20 20 20 20 20 20 20 t* ((id
23d0: 28 6c 69 73 74 2d 72 65 66 20 72 6f 77 20 30 29 (list-ref row 0)
23e0: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 74 65 )..... (te
23f0: 73 74 6e 61 6d 65 20 20 20 28 6c 69 73 74 2d 72 stname (list-r
2400: 65 66 20 72 6f 77 20 31 29 29 0a 09 09 09 09 20 ef row 1)).....
2410: 20 20 20 20 20 20 28 69 74 65 6d 70 61 74 68 20 (itempath
2420: 20 20 28 6c 69 73 74 2d 72 65 66 20 72 6f 77 20 (list-ref row
2430: 32 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 2))..... (
2440: 73 74 61 74 65 20 20 20 20 20 20 28 6c 69 73 74 state (list
2450: 2d 72 65 66 20 72 6f 77 20 33 29 29 0a 09 09 09 -ref row 3))....
2460: 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20 . (status
2470: 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 72 6f (list-ref ro
2480: 77 20 34 29 29 0a 09 09 09 09 20 20 20 20 20 20 w 4)).....
2490: 20 28 65 76 65 6e 74 74 69 6d 20 20 20 28 6c 69 (eventtim (li
24a0: 73 74 2d 72 65 66 20 72 6f 77 20 35 29 29 0a 09 st-ref row 5))..
24b0: 09 09 09 20 20 20 20 20 20 20 28 64 75 72 61 74 ... (durat
24c0: 69 6f 6e 20 20 20 28 6c 69 73 74 2d 72 65 66 20 ion (list-ref
24d0: 72 6f 77 20 36 29 29 29 0a 09 09 09 09 20 20 28 row 6)))..... (
24e0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
24f0: 74 65 73 74 73 20 69 64 0a 09 09 09 09 09 09 20 tests id.......
2500: 20 20 28 6d 61 6b 65 2d 74 65 73 74 64 61 74 20 (make-testdat
2510: 72 75 6e 2d 69 64 20 69 64 20 74 65 73 74 6e 61 run-id id testna
2520: 6d 65 20 69 74 65 6d 70 61 74 68 20 73 74 61 74 me itempath stat
2530: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 74 69 e status eventti
2540: 6d 20 64 75 72 61 74 69 6f 6e 29 29 29 29 29 0a m duration))))).
2550: 09 09 28 73 71 6c 20 72 75 6e 64 62 20 22 53 45 ..(sql rundb "SE
2560: 4c 45 43 54 20 69 64 2c 74 65 73 74 6e 61 6d 65 LECT id,testname
2570: 2c 69 74 65 6d 5f 70 61 74 68 2c 73 74 61 74 65 ,item_path,state
2580: 2c 73 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 ,status,event_ti
2590: 6d 65 2c 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 me,run_duration
25a0: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
25b0: 20 73 74 61 74 65 20 21 3d 20 27 44 45 4c 45 54 state != 'DELET
25c0: 45 44 27 3b 22 29 29 29 29 0a 20 20 20 20 20 28 ED';")))). (
25d0: 6f 72 20 72 75 6e 2d 69 64 73 20 28 68 61 73 68 or run-ids (hash
25e0: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 72 75 6e 73 -table-keys runs
25f0: 29 29 29 0a 20 20 20 20 61 72 65 61 64 61 74 29 ))). areadat)
2600: 29 0a 20 20 20 20 0a 0a 3b 3b 20 69 6e 69 74 69 ). ..;; initi
2610: 61 6c 69 7a 65 20 61 6e 64 20 72 65 66 72 65 73 alize and refres
2620: 68 20 64 61 74 61 0a 3b 3b 09 09 0a 28 64 65 66 h data.;;...(def
2630: 69 6e 65 20 28 64 62 6f 61 72 64 3a 67 65 6e 65 ine (dboard:gene
2640: 72 61 6c 2d 75 70 64 61 74 65 72 20 63 6f 6e 20 ral-updater con
2650: 70 6f 72 74 29 0a 20 20 28 66 6f 72 2d 65 61 63 port). (for-eac
2660: 68 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 77 69 h. (lambda (wi
2670: 6e 64 6f 77 2d 69 64 29 0a 20 20 20 20 20 3b 3b ndow-id). ;;
2680: 20 28 70 72 69 6e 74 20 22 50 72 6f 63 65 73 73 (print "Process
2690: 69 6e 67 20 66 6f 72 20 77 69 6e 64 6f 77 2d 69 ing for window-i
26a0: 64 20 22 20 77 69 6e 64 6f 77 2d 69 64 29 0a 20 d " window-id).
26b0: 20 20 20 20 28 6c 65 74 2a 20 28 28 77 69 6e 64 (let* ((wind
26c0: 6f 77 2d 64 61 74 20 20 20 20 20 28 68 61 73 68 ow-dat (hash
26d0: 2d 74 61 62 6c 65 2d 72 65 66 20 2a 77 69 6e 64 -table-ref *wind
26e0: 6f 77 73 2a 20 77 69 6e 64 6f 77 2d 69 64 29 29 ows* window-id))
26f0: 0a 09 20 20 20 20 28 61 72 65 61 73 20 20 20 20 .. (areas
2700: 20 20 20 20 20 20 28 64 61 74 61 2d 61 72 65 61 (data-area
2710: 73 20 20 20 20 20 77 69 6e 64 6f 77 2d 64 61 74 s window-dat
2720: 29 29 0a 09 20 20 20 20 3b 3b 20 28 6b 65 79 73 )).. ;; (keys
2730: 20 20 20 20 20 20 20 20 20 20 20 28 61 72 65 61 (area
2740: 64 61 74 2d 72 75 6e 2d 6b 65 79 73 20 61 72 65 dat-run-keys are
2750: 61 2d 64 61 74 29 29 0a 09 20 20 20 20 28 74 61 a-dat)).. (ta
2760: 62 73 20 20 20 20 20 20 20 20 20 20 20 28 64 61 bs (da
2770: 74 61 2d 74 61 62 73 20 20 20 20 20 20 77 69 6e ta-tabs win
2780: 64 6f 77 2d 64 61 74 29 29 0a 09 20 20 20 20 28 dow-dat)).. (
2790: 74 61 62 2d 69 64 73 20 20 20 20 20 20 20 20 28 tab-ids (
27a0: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys
27b0: 74 61 62 73 29 29 0a 09 20 20 20 20 28 63 75 72 tabs)).. (cur
27c0: 72 65 6e 74 2d 74 61 62 20 20 20 20 28 69 66 20 rent-tab (if
27d0: 28 6e 75 6c 6c 3f 20 74 61 62 2d 69 64 73 29 0a (null? tab-ids).
27e0: 09 09 09 09 23 66 0a 09 09 09 09 28 68 61 73 68 ....#f.....(hash
27f0: 2d 74 61 62 6c 65 2d 72 65 66 20 74 61 62 73 20 -table-ref tabs
2800: 28 63 61 72 20 74 61 62 2d 69 64 73 29 29 29 29 (car tab-ids))))
2810: 0a 09 20 20 20 20 28 63 75 72 72 65 6e 74 2d 74 .. (current-t
2820: 72 65 65 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f ree (if (null?
2830: 20 74 61 62 2d 69 64 73 29 20 23 66 20 28 74 61 tab-ids) #f (ta
2840: 62 2d 74 72 65 65 20 20 20 63 75 72 72 65 6e 74 b-tree current
2850: 2d 74 61 62 29 29 29 0a 09 20 20 20 20 28 63 75 -tab))).. (cu
2860: 72 72 65 6e 74 2d 6e 6f 64 65 20 20 20 28 69 66 rrent-node (if
2870: 20 28 6e 75 6c 6c 3f 20 74 61 62 2d 69 64 73 29 (null? tab-ids)
2880: 20 30 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 0 (string->num
2890: 62 65 72 20 28 69 75 70 3a 61 74 74 72 69 62 75 ber (iup:attribu
28a0: 74 65 20 63 75 72 72 65 6e 74 2d 74 72 65 65 20 te current-tree
28b0: 22 56 41 4c 55 45 22 29 29 29 29 0a 09 20 20 20 "VALUE"))))..
28c0: 20 28 63 75 72 72 65 6e 74 2d 70 61 74 68 20 20 (current-path
28d0: 20 28 69 66 20 28 65 71 3f 20 63 75 72 72 65 6e (if (eq? curren
28e0: 74 2d 6e 6f 64 65 20 30 29 0a 09 09 09 09 22 41 t-node 0)....."A
28f0: 72 65 61 73 22 0a 09 09 09 09 28 73 74 72 69 6e reas".....(strin
2900: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 74 g-intersperse (t
2910: 72 65 65 3a 6e 6f 64 65 2d 3e 70 61 74 68 20 63 ree:node->path c
2920: 75 72 72 65 6e 74 2d 74 72 65 65 20 63 75 72 72 urrent-tree curr
2930: 65 6e 74 2d 6e 6f 64 65 29 20 22 2f 22 29 29 29 ent-node) "/")))
2940: 0a 09 20 20 20 20 28 63 75 72 72 65 6e 74 2d 6d .. (current-m
2950: 61 74 72 69 78 20 28 69 66 20 28 6e 75 6c 6c 3f atrix (if (null?
2960: 20 74 61 62 2d 69 64 73 29 20 23 66 20 28 74 61 tab-ids) #f (ta
2970: 62 2d 6d 61 74 72 69 78 20 63 75 72 72 65 6e 74 b-matrix current
2980: 2d 74 61 62 29 29 29 0a 09 20 20 20 20 28 73 65 -tab))).. (se
2990: 65 6e 2d 6e 6f 64 65 73 20 20 20 20 20 28 6d 61 en-nodes (ma
29a0: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
29b0: 09 20 20 20 20 28 70 61 74 68 2d 63 68 61 6e 67 . (path-chang
29c0: 65 64 20 20 20 28 69 66 20 63 75 72 72 65 6e 74 ed (if current
29d0: 2d 74 61 62 0a 09 09 09 09 28 65 71 75 61 6c 3f -tab.....(equal?
29e0: 20 63 75 72 72 65 6e 74 2d 70 61 74 68 20 28 74 current-path (t
29f0: 61 62 2d 76 69 65 77 2d 70 61 74 68 20 63 75 72 ab-view-path cur
2a00: 72 65 6e 74 2d 74 61 62 29 29 0a 09 09 09 09 23 rent-tab)).....#
2a10: 74 29 29 29 0a 20 20 20 20 20 20 20 3b 3b 20 28 t))). ;; (
2a20: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
2a30: 20 30 20 22 43 75 72 72 65 6e 74 20 70 61 74 68 0 "Current path
2a40: 3a 20 22 20 63 75 72 72 65 6e 74 2d 70 61 74 68 : " current-path
2a50: 29 0a 20 20 20 20 20 20 20 3b 3b 20 6e 6f 77 20 ). ;; now
2a60: 66 6f 72 20 65 61 63 68 20 61 72 65 61 20 69 6e for each area in
2a70: 20 74 68 65 20 77 69 6e 64 6f 77 20 67 61 74 68 the window gath
2a80: 65 72 20 74 68 65 20 64 61 74 61 0a 20 20 20 20 er the data.
2a90: 20 20 20 28 69 66 20 70 61 74 68 2d 63 68 61 6e (if path-chan
2aa0: 67 65 64 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 ged.. (begin..
2ab0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
2ac0: 74 2d 69 6e 66 6f 20 30 20 22 63 6c 65 61 72 69 t-info 0 "cleari
2ad0: 6e 67 20 6d 61 74 72 69 78 20 2d 20 70 61 74 68 ng matrix - path
2ae0: 20 63 68 61 6e 67 65 64 22 29 0a 09 20 20 20 20 changed")..
2af0: 20 28 64 62 6f 61 72 64 3a 63 6c 65 61 72 2d 6d (dboard:clear-m
2b00: 61 74 72 69 78 20 63 75 72 72 65 6e 74 2d 74 61 atrix current-ta
2b10: 62 29 29 29 0a 20 20 20 20 20 20 20 28 66 6f 72 b))). (for
2b20: 2d 65 61 63 68 0a 09 28 6c 61 6d 62 64 61 20 28 -each..(lambda (
2b30: 61 72 65 61 2d 6e 61 6d 65 29 0a 09 20 20 3b 3b area-name).. ;;
2b40: 20 28 70 72 69 6e 74 20 22 50 72 6f 63 65 73 73 (print "Process
2b50: 69 6e 67 20 66 6f 72 20 61 72 65 61 2d 6e 61 6d ing for area-nam
2b60: 65 20 22 20 61 72 65 61 2d 6e 61 6d 65 29 0a 09 e " area-name)..
2b70: 20 20 28 6c 65 74 2a 20 28 28 61 72 65 61 2d 64 (let* ((area-d
2b80: 61 74 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d at (hash-table-
2b90: 72 65 66 20 61 72 65 61 73 20 61 72 65 61 2d 6e ref areas area-n
2ba0: 61 6d 65 29 29 0a 09 09 20 28 61 72 65 61 2d 70 ame))... (area-p
2bb0: 61 74 68 20 28 61 72 65 61 64 61 74 2d 70 61 74 ath (areadat-pat
2bc0: 68 20 20 20 61 72 65 61 2d 64 61 74 29 29 0a 09 h area-dat))..
2bd0: 09 20 28 72 75 6e 73 20 20 20 20 20 20 28 61 72 . (runs (ar
2be0: 65 61 64 61 74 2d 72 75 6e 73 20 20 20 61 72 65 eadat-runs are
2bf0: 61 2d 64 61 74 29 29 29 0a 09 20 20 20 20 28 69 a-dat))).. (i
2c00: 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 f (hash-table-re
2c10: 66 2f 64 65 66 61 75 6c 74 20 2a 63 68 61 6e 67 f/default *chang
2c20: 65 64 2d 6d 61 69 6e 2a 20 61 72 65 61 2d 70 61 ed-main* area-pa
2c30: 74 68 20 27 70 72 6f 63 65 73 73 65 64 29 0a 09 th 'processed)..
2c40: 09 28 62 65 67 69 6e 0a 09 09 20 20 28 70 72 69 .(begin... (pri
2c50: 6e 74 20 22 50 72 6f 63 65 73 73 69 6e 67 20 22 nt "Processing "
2c60: 20 61 72 65 61 2d 64 61 74 20 22 20 66 6f 72 20 area-dat " for
2c70: 61 72 65 61 2d 6e 61 6d 65 20 22 20 61 72 65 61 area-name " area
2c80: 2d 6e 61 6d 65 29 0a 09 09 20 20 28 68 61 73 68 -name)... (hash
2c90: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 63 68 61 -table-set! *cha
2ca0: 6e 67 65 64 2d 6d 61 69 6e 2a 20 61 72 65 61 2d nged-main* area-
2cb0: 70 61 74 68 20 23 66 29 0a 09 09 20 20 28 61 72 path #f)... (ar
2cc0: 65 61 64 62 3a 70 6f 70 75 6c 61 74 65 2d 72 75 eadb:populate-ru
2cd0: 6e 2d 69 6e 66 6f 20 61 72 65 61 2d 64 61 74 29 n-info area-dat)
2ce0: 0a 09 09 20 20 28 66 6f 72 2d 65 61 63 68 20 0a ... (for-each .
2cf0: 09 09 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 .. (lambda (ru
2d00: 6e 2d 69 64 29 0a 09 09 20 20 20 20 20 28 6c 65 n-id)... (le
2d10: 74 2a 20 28 28 72 75 6e 20 20 20 20 20 28 68 61 t* ((run (ha
2d20: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 72 75 6e sh-table-ref run
2d30: 73 20 72 75 6e 2d 69 64 29 29 0a 09 09 09 20 20 s run-id))....
2d40: 20 20 28 74 61 72 67 65 74 20 20 28 72 75 6e 64 (target (rund
2d50: 61 74 2d 74 61 72 67 65 74 20 72 75 6e 29 29 0a at-target run)).
2d60: 09 09 09 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 ... (runname
2d70: 28 72 75 6e 64 61 74 2d 72 75 6e 6e 61 6d 65 20 (rundat-runname
2d80: 72 75 6e 29 29 29 0a 09 09 20 20 20 20 20 20 20 run)))...
2d90: 28 69 66 20 63 75 72 72 65 6e 74 2d 74 72 65 65 (if current-tree
2da0: 0a 09 09 09 20 20 20 28 6c 65 74 2a 20 28 28 70 .... (let* ((p
2db0: 61 72 74 69 61 6c 2d 70 61 74 68 20 28 61 70 70 artial-path (app
2dc0: 65 6e 64 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 end (string-spli
2dd0: 74 20 74 61 72 67 65 74 20 22 2f 22 29 28 6c 69 t target "/")(li
2de0: 73 74 20 72 75 6e 6e 61 6d 65 29 29 29 0a 09 09 st runname)))...
2df0: 09 09 20 20 28 66 75 6c 6c 2d 70 61 74 68 20 20 .. (full-path
2e00: 20 20 28 63 6f 6e 73 20 61 72 65 61 2d 6e 61 6d (cons area-nam
2e10: 65 20 70 61 72 74 69 61 6c 2d 70 61 74 68 29 29 e partial-path))
2e20: 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 28 6e ).... (if (n
2e30: 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 65 ot (hash-table-e
2e40: 78 69 73 74 73 3f 20 73 65 65 6e 2d 6e 6f 64 65 xists? seen-node
2e50: 73 20 66 75 6c 6c 2d 70 61 74 68 29 29 0a 09 09 s full-path))...
2e60: 09 09 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 .. (begin.....
2e70: 20 28 70 72 69 6e 74 20 22 49 4e 46 4f 3a 20 41 (print "INFO: A
2e80: 64 64 69 6e 67 20 6e 6f 64 65 20 22 20 70 61 72 dding node " par
2e90: 74 69 61 6c 2d 70 61 74 68 20 22 20 74 6f 20 73 tial-path " to s
2ea0: 65 63 74 69 6f 6e 20 22 20 61 72 65 61 2d 6e 61 ection " area-na
2eb0: 6d 65 29 0a 09 09 09 09 20 20 20 28 74 72 65 65 me)..... (tree
2ec0: 3a 61 64 64 2d 6e 6f 64 65 20 63 75 72 72 65 6e :add-node curren
2ed0: 74 2d 74 72 65 65 20 22 41 72 65 61 73 22 20 66 t-tree "Areas" f
2ee0: 75 6c 6c 2d 70 61 74 68 29 0a 09 09 09 09 20 20 ull-path).....
2ef0: 20 28 61 72 65 61 64 62 3a 66 69 6c 6c 2d 74 65 (areadb:fill-te
2f00: 73 74 73 20 61 72 65 61 2d 64 61 74 20 72 75 6e sts area-dat run
2f10: 2d 69 64 73 3a 20 28 6c 69 73 74 20 72 75 6e 2d -ids: (list run-
2f20: 69 64 29 29 29 29 0a 09 09 09 09 20 20 20 28 68 id))))..... (h
2f30: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 ash-table-set! s
2f40: 65 65 6e 2d 6e 6f 64 65 73 20 66 75 6c 6c 2d 70 een-nodes full-p
2f50: 61 74 68 20 23 74 29 29 29 29 29 0a 09 09 20 20 ath #t)))))...
2f60: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 (hash-table-key
2f70: 73 20 72 75 6e 73 29 29 29 29 0a 09 20 20 20 20 s runs))))..
2f80: 28 69 66 20 28 6f 72 20 28 65 71 75 61 6c 3f 20 (if (or (equal?
2f90: 22 41 72 65 61 73 22 20 63 75 72 72 65 6e 74 2d "Areas" current-
2fa0: 70 61 74 68 29 0a 09 09 20 20 20 20 28 73 74 72 path)... (str
2fb0: 69 6e 67 2d 6d 61 74 63 68 20 28 63 6f 6e 63 20 ing-match (conc
2fc0: 22 5e 41 72 65 61 73 2f 22 20 61 72 65 61 2d 6e "^Areas/" area-n
2fd0: 61 6d 65 20 22 28 7c 5c 5c 2f 2e 2a 29 24 22 29 ame "(|\\/.*)$")
2fe0: 20 63 75 72 72 65 6e 74 2d 70 61 74 68 29 29 0a current-path)).
2ff0: 09 09 28 64 62 6f 61 72 64 3a 72 65 64 72 61 77 ..(dboard:redraw
3000: 2d 61 72 65 61 20 61 72 65 61 2d 6e 61 6d 65 20 -area area-name
3010: 61 72 65 61 2d 64 61 74 20 63 75 72 72 65 6e 74 area-dat current
3020: 2d 74 61 62 20 63 75 72 72 65 6e 74 2d 6d 61 74 -tab current-mat
3030: 72 69 78 20 63 75 72 72 65 6e 74 2d 70 61 74 68 rix current-path
3040: 29 29 29 29 0a 09 28 68 61 73 68 2d 74 61 62 6c ))))..(hash-tabl
3050: 65 2d 6b 65 79 73 20 61 72 65 61 73 29 29 29 29 e-keys areas))))
3060: 0a 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d . (hash-table-
3070: 6b 65 79 73 20 2a 77 69 6e 64 6f 77 73 2a 29 29 keys *windows*))
3080: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
3090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
30c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 44 ===========.;; D
30d0: 20 41 20 53 20 48 20 42 20 4f 20 41 20 52 20 44 A S H B O A R D
30e0: 20 20 20 44 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d 3d D B .;;======
30f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3130: 0a 0a 3b 3b 20 41 6c 6c 20 6d 6f 76 65 64 20 74 ..;; All moved t
3140: 6f 20 63 6f 6d 6d 6f 6e 2e 73 63 6d 09 09 0a 0a o common.scm....
3150: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
3160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3190: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 20 52 20 ========.;; T R
31a0: 45 20 45 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d E E .;;=========
31b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
31c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
31d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
31e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
31f0: 3b 20 3c 61 72 65 61 3e 20 2d 20 3c 74 61 72 67 ; <area> - <targ
3200: 65 74 20 2d 20 2e 2e 2e 20 3e 20 2d 20 3c 72 75 et - ... > - <ru
3210: 6e 6e 61 6d 65 3e 20 2d 20 3c 74 65 73 74 3e 20 nname> - <test>
3220: 2d 20 3c 69 74 65 6d 70 61 74 68 20 2d 20 2e 2e - <itempath - ..
3230: 2e 3e 0a 0a 28 64 65 66 69 6e 65 20 28 64 61 73 .>..(define (das
3240: 68 62 6f 61 72 64 3a 74 72 65 65 2d 62 72 6f 77 hboard:tree-brow
3250: 73 65 72 20 64 61 74 61 20 61 64 61 74 20 77 69 ser data adat wi
3260: 6e 64 6f 77 2d 69 64 29 0a 20 20 3b 3b 20 28 69 ndow-id). ;; (i
3270: 75 70 3a 73 70 6c 69 74 0a 20 20 28 6c 65 74 2a up:split. (let*
3280: 20 28 28 74 62 20 20 20 20 20 20 28 69 75 70 3a ((tb (iup:
3290: 74 72 65 65 62 6f 78 0a 09 09 20 20 20 23 3a 76 treebox... #:v
32a0: 61 6c 75 65 20 30 0a 09 09 20 20 20 23 3a 74 69 alue 0... #:ti
32b0: 74 6c 65 20 22 41 72 65 61 73 22 0a 09 09 20 20 tle "Areas"...
32c0: 20 23 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a #:expand "YES".
32d0: 09 09 20 20 20 23 3a 61 64 64 65 78 70 61 6e 64 .. #:addexpand
32e0: 65 64 20 22 4e 4f 22 0a 09 09 20 20 20 23 3a 73 ed "NO"... #:s
32f0: 65 6c 65 63 74 69 6f 6e 2d 63 62 0a 09 09 20 20 election-cb...
3300: 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 69 64 (lambda (obj id
3310: 20 73 74 61 74 65 29 0a 09 09 20 20 20 20 20 3b state)... ;
3320: 3b 20 28 70 72 69 6e 74 20 22 6f 62 6a 3a 20 22 ; (print "obj: "
3330: 20 6f 62 6a 20 22 2c 20 69 64 3a 20 22 20 69 64 obj ", id: " id
3340: 20 22 2c 20 73 74 61 74 65 3a 20 22 20 73 74 61 ", state: " sta
3350: 74 65 29 0a 09 09 20 20 20 20 20 28 6c 65 74 2a te)... (let*
3360: 20 28 28 74 72 65 65 2d 70 61 74 68 20 28 74 72 ((tree-path (tr
3370: 65 65 3a 6e 6f 64 65 2d 3e 70 61 74 68 20 6f 62 ee:node->path ob
3380: 6a 20 69 64 29 29 0a 09 09 09 20 20 20 20 28 61 j id)).... (a
3390: 72 65 61 20 20 20 20 20 20 28 63 61 72 20 74 72 rea (car tr
33a0: 65 65 2d 70 61 74 68 29 29 0a 09 09 09 20 20 20 ee-path))....
33b0: 20 28 61 72 65 61 64 61 74 2d 70 61 74 68 20 28 (areadat-path (
33c0: 63 64 72 20 74 72 65 65 2d 70 61 74 68 29 29 29 cdr tree-path)))
33d0: 0a 09 09 20 20 20 20 20 20 20 23 66 0a 09 09 20 ... #f...
33e0: 20 20 20 20 20 20 3b 3b 20 28 74 65 73 74 2d 69 ;; (test-i
33f0: 64 20 20 28 74 72 65 65 2d 70 61 74 68 2d 3e 74 d (tree-path->t
3400: 65 73 74 2d 69 64 20 28 63 64 72 20 72 75 6e 2d est-id (cdr run-
3410: 70 61 74 68 29 29 29 29 0a 09 09 20 20 20 20 20 path))))...
3420: 20 20 3b 3b 20 28 69 66 20 74 65 73 74 2d 69 64 ;; (if test-id
3430: 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 20 20 20 ... ;;
3440: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
3450: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 67 65 (dboard:data-ge
3460: 74 2d 63 75 72 72 2d 74 65 73 74 2d 69 64 73 20 t-curr-test-ids
3470: 2a 64 61 74 61 2a 29 0a 09 09 20 20 20 20 20 20 *data*)...
3480: 20 3b 3b 09 09 20 20 20 20 20 77 69 6e 64 6f 77 ;;.. window
3490: 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a 09 09 -id test-id))...
34a0: 20 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 ;; (print
34b0: 20 22 70 61 74 68 3a 20 22 20 28 74 72 65 65 3a "path: " (tree:
34c0: 6e 6f 64 65 2d 3e 70 61 74 68 20 6f 62 6a 20 69 node->path obj i
34d0: 64 29 20 22 20 74 65 73 74 2d 69 64 3a 20 22 20 d) " test-id: "
34e0: 74 65 73 74 2d 69 64 29 29 29 29 29 29 0a 09 09 test-id))))))...
34f0: 20 20 20 20 20 20 20 29 29 29 29 29 0a 20 20 20 ))))).
3500: 20 3b 3b 20 28 69 75 70 3a 61 74 74 72 69 62 75 ;; (iup:attribu
3510: 74 65 2d 73 65 74 21 20 74 62 20 22 56 41 4c 55 te-set! tb "VALU
3520: 45 22 20 22 30 22 29 0a 20 20 20 20 3b 3b 20 28 E" "0"). ;; (
3530: 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 iup:attribute-se
3540: 74 21 20 74 62 20 22 4e 41 4d 45 22 20 22 52 75 t! tb "NAME" "Ru
3550: 6e 73 22 29 0a 20 20 20 20 3b 3b 20 28 69 75 70 ns"). ;; (iup
3560: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
3570: 74 62 20 22 41 44 44 45 58 50 41 4e 44 45 44 22 tb "ADDEXPANDED"
3580: 20 22 4e 4f 22 29 0a 20 20 20 20 3b 3b 20 28 64 "NO"). ;; (d
3590: 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 74 2d 74 board:data-set-t
35a0: 65 73 74 73 2d 74 72 65 65 21 20 2a 64 61 74 61 ests-tree! *data
35b0: 2a 20 74 62 29 0a 20 20 20 20 74 62 29 29 0a 0a * tb). tb))..
35c0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
35d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3600: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 20 41 20 ========.;; M A
3610: 49 20 4e 20 20 20 4d 20 41 20 54 20 52 20 49 20 I N M A T R I
3620: 58 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d X.;;============
3630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 47 ==========..;; G
3670: 65 6e 65 72 61 6c 20 64 69 73 70 6c 61 79 65 72 eneral displayer
3680: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 61 73 .;;.(define (das
3690: 68 62 6f 61 72 64 3a 6d 61 69 6e 2d 6d 61 74 72 hboard:main-matr
36a0: 69 78 20 64 61 74 61 20 61 64 61 74 20 77 69 6e ix data adat win
36b0: 64 6f 77 2d 69 64 29 0a 20 20 28 6c 65 74 2a 20 dow-id). (let*
36c0: 28 3b 3b 20 28 74 61 62 2d 64 61 74 20 20 20 20 (;; (tab-dat
36d0: 20 20 20 20 20 28 61 72 65 61 64 61 74 2d 0a 09 (areadat-..
36e0: 20 28 76 69 65 77 2d 6d 61 74 72 69 78 20 20 20 (view-matrix
36f0: 20 20 28 69 75 70 3a 6d 61 74 72 69 78 0a 09 09 (iup:matrix...
3700: 09 20 20 20 3b 3b 20 28 72 75 6e 73 2d 66 6f 72 . ;; (runs-for
3710: 2d 74 61 72 67 20 28 64 62 3a 67 65 74 2d 72 75 -targ (db:get-ru
3720: 6e 73 2d 62 79 2d 70 61 74 74 20 2a 64 62 73 74 ns-by-patt *dbst
3730: 72 75 63 74 2d 6c 6f 63 61 6c 2a 20 2a 6b 65 79 ruct-local* *key
3740: 73 2a 20 22 25 22 20 74 61 72 67 65 74 20 23 66 s* "%" target #f
3750: 20 23 66 20 23 66 29 29 0a 09 09 09 20 20 20 23 #f #f)).... #
3760: 3a 65 78 70 61 6e 64 20 22 59 45 53 22 0a 09 09 :expand "YES"...
3770: 09 20 20 20 3b 3b 20 23 3a 66 69 74 74 6f 73 69 . ;; #:fittosi
3780: 7a 65 20 22 59 45 53 22 0a 09 09 09 20 20 20 23 ze "YES".... #
3790: 3a 72 65 73 69 7a 65 6d 61 74 72 69 78 20 22 59 :resizematrix "Y
37a0: 45 53 22 0a 09 09 09 20 20 20 23 3a 73 63 72 6f ES".... #:scro
37b0: 6c 6c 62 61 72 20 22 59 45 53 22 0a 09 09 09 20 llbar "YES"....
37c0: 20 20 23 3a 6e 75 6d 63 6f 6c 20 31 30 30 0a 09 #:numcol 100..
37d0: 09 09 20 20 20 23 3a 6e 75 6d 6c 69 6e 20 31 30 .. #:numlin 10
37e0: 30 0a 09 09 09 20 20 20 23 3a 6e 75 6d 63 6f 6c 0.... #:numcol
37f0: 2d 76 69 73 69 62 6c 65 20 33 0a 09 09 09 20 20 -visible 3....
3800: 20 23 3a 6e 75 6d 6c 69 6e 2d 76 69 73 69 62 6c #:numlin-visibl
3810: 65 20 32 30 0a 09 09 09 20 20 20 23 3a 63 6c 69 e 20.... #:cli
3820: 63 6b 2d 63 62 20 28 6c 61 6d 62 64 61 20 28 6f ck-cb (lambda (o
3830: 62 6a 20 6c 69 6e 20 63 6f 6c 20 73 74 61 74 75 bj lin col statu
3840: 73 29 0a 09 09 09 09 09 28 70 72 69 6e 74 20 22 s)......(print "
3850: 6f 62 6a 3a 20 22 20 6f 62 6a 20 22 20 6c 69 6e obj: " obj " lin
3860: 3a 20 22 20 6c 69 6e 20 22 20 63 6f 6c 3a 20 22 : " lin " col: "
3870: 20 63 6f 6c 20 22 20 73 74 61 74 75 73 3a 20 22 col " status: "
3880: 20 73 74 61 74 75 73 20 22 20 76 61 6c 75 65 3a status " value:
3890: 20 22 20 28 69 75 70 3a 61 74 74 72 69 62 75 74 " (iup:attribut
38a0: 65 20 6f 62 6a 20 22 56 41 4c 55 45 22 29 29 29 e obj "VALUE")))
38b0: 29 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 ))). . ;;
38c0: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 (iup:attribute-s
38d0: 65 74 21 20 76 69 65 77 2d 6d 61 74 72 69 78 20 et! view-matrix
38e0: 22 52 45 53 49 5a 45 4d 41 54 52 49 58 22 20 22 "RESIZEMATRIX" "
38f0: 59 45 53 22 29 0a 20 20 20 20 28 69 75 70 3a 61 YES"). (iup:a
3900: 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 76 69 ttribute-set! vi
3910: 65 77 2d 6d 61 74 72 69 78 20 22 57 49 44 54 48 ew-matrix "WIDTH
3920: 30 22 20 22 31 30 30 22 29 0a 20 20 20 20 3b 3b 0" "100"). ;;
3930: 20 28 64 62 6f 61 72 64 3a 64 61 74 61 2d 73 65 (dboard:data-se
3940: 74 2d 72 75 6e 73 2d 6d 61 74 72 69 78 21 20 2a t-runs-matrix! *
3950: 64 61 74 61 2a 20 72 75 6e 73 2d 6d 61 74 72 69 data* runs-matri
3960: 78 29 0a 20 20 20 20 3b 3b 20 28 69 75 70 3a 68 x). ;; (iup:h
3970: 62 6f 78 0a 20 20 20 20 3b 3b 20 20 28 69 75 70 box. ;; (iup
3980: 3a 66 72 61 6d 65 20 0a 20 20 20 20 3b 3b 20 20 :frame . ;;
3990: 20 23 3a 74 69 74 6c 65 20 22 52 75 6e 73 20 62 #:title "Runs b
39a0: 72 6f 77 73 65 72 22 0a 20 20 20 20 3b 3b 20 20 rowser". ;;
39b0: 20 28 69 75 70 3a 76 62 6f 78 0a 20 20 20 20 76 (iup:vbox. v
39c0: 69 65 77 2d 6d 61 74 72 69 78 29 29 0a 0a 3b 3b iew-matrix))..;;
39d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
39e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
39f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a10: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 20 52 20 45 20 ======.;; A R E
3a20: 41 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d A S.;;==========
3a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
3a70: 65 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 64 efine (dashboard
3a80: 3a 69 6e 69 74 2d 61 72 65 61 20 64 61 74 61 20 :init-area data
3a90: 61 72 65 61 2d 6e 61 6d 65 20 61 70 61 74 68 29 area-name apath)
3aa0: 0a 20 20 28 6c 65 74 2a 20 28 28 6d 74 63 6f 6e . (let* ((mtcon
3ab0: 66 20 20 20 20 20 20 28 64 62 6f 61 72 64 3a 72 f (dboard:r
3ac0: 65 61 64 2d 6d 74 63 6f 6e 66 20 61 70 61 74 68 ead-mtconf apath
3ad0: 29 29 0a 09 20 28 61 72 65 61 2d 64 61 74 20 20 )).. (area-dat
3ae0: 20 20 28 6c 65 74 20 28 28 61 64 20 28 6d 61 6b (let ((ad (mak
3af0: 65 2d 61 72 65 61 64 61 74 0a 09 09 09 09 20 61 e-areadat..... a
3b00: 72 65 61 2d 6e 61 6d 65 20 3b 3b 20 61 72 65 61 rea-name ;; area
3b10: 20 6e 61 6d 65 0a 09 09 09 09 20 61 70 61 74 68 name..... apath
3b20: 20 20 20 20 20 3b 3b 20 70 61 74 68 20 74 6f 20 ;; path to
3b30: 61 72 65 61 0a 09 09 09 09 20 3b 3b 20 27 68 74 area..... ;; 'ht
3b40: 74 70 20 20 20 20 20 3b 3b 20 74 72 61 6e 73 70 tp ;; transp
3b50: 6f 72 74 0a 09 09 09 09 20 6d 74 63 6f 6e 66 20 ort..... mtconf
3b60: 20 20 20 3b 3b 20 6d 65 67 61 74 65 73 74 2e 63 ;; megatest.c
3b70: 6f 6e 66 69 67 0a 09 09 09 09 20 28 6d 61 6b 65 onfig..... (make
3b80: 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 3b 3b 20 -hash-table) ;;
3b90: 64 65 6e 6f 69 73 65 20 68 61 73 68 0a 09 09 09 denoise hash....
3ba0: 09 20 23 66 20 20 20 20 20 20 20 20 3b 3b 20 63 . #f ;; c
3bb0: 6c 69 65 6e 74 2d 73 69 67 6e 61 74 75 72 65 0a lient-signature.
3bc0: 09 09 09 09 20 23 66 20 20 20 20 20 20 20 20 3b .... #f ;
3bd0: 3b 20 72 65 6d 6f 74 65 20 63 6f 6e 6e 65 63 74 ; remote connect
3be0: 69 6f 6e 73 0a 09 09 09 09 20 28 6b 65 79 73 3a ions..... (keys:
3bf0: 63 6f 6e 66 69 67 2d 67 65 74 2d 66 69 65 6c 64 config-get-field
3c00: 73 20 6d 74 63 6f 6e 66 29 20 3b 3b 20 72 75 6e s mtconf) ;; run
3c10: 20 6b 65 79 73 0a 09 09 09 09 20 28 6d 61 6b 65 keys..... (make
3c20: 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 3b 3b 20 -hash-table) ;;
3c30: 72 75 6e 2d 69 64 20 2d 3e 20 28 68 61 73 68 20 run-id -> (hash
3c40: 6f 66 20 74 65 73 74 2d 69 64 73 20 3d 3e 20 64 of test-ids => d
3c50: 61 74 29 0a 09 09 09 09 20 28 61 6e 64 20 28 66 at)..... (and (f
3c60: 69 6c 65 2d 65 78 69 73 74 73 3f 20 61 70 61 74 ile-exists? apat
3c70: 68 29 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 h)(file-write-ac
3c80: 63 65 73 73 3f 20 61 70 61 74 68 29 29 20 3b 3b cess? apath)) ;;
3c90: 20 72 65 61 64 2d 6f 6e 6c 79 0a 09 09 09 09 20 read-only.....
3ca0: 23 66 0a 09 09 09 09 20 23 66 0a 09 09 09 09 20 #f..... #f.....
3cb0: 29 29 29 0a 09 09 09 28 68 61 73 68 2d 74 61 62 )))....(hash-tab
3cc0: 6c 65 2d 73 65 74 21 20 28 64 61 74 61 2d 61 72 le-set! (data-ar
3cd0: 65 61 73 20 64 61 74 61 29 20 61 72 65 61 2d 6e eas data) area-n
3ce0: 61 6d 65 20 61 64 29 0a 09 09 09 61 64 29 29 29 ame ad)....ad)))
3cf0: 0a 20 20 20 20 61 72 65 61 2d 64 61 74 29 29 0a . area-dat)).
3d00: 0a 3b 3b 20 67 69 76 65 6e 20 74 68 65 20 6b 65 .;; given the ke
3d10: 79 73 20 66 6f 72 20 61 6e 20 61 72 65 61 20 61 ys for an area a
3d20: 6e 64 20 61 20 70 61 74 68 20 66 72 6f 6d 20 74 nd a path from t
3d30: 68 65 20 74 72 65 65 20 62 72 6f 77 73 65 72 0a he tree browser.
3d40: 3b 3b 20 72 65 74 75 72 6e 20 74 68 65 20 6c 65 ;; return the le
3d50: 76 65 6c 3a 20 61 72 65 61 73 20 61 72 65 61 20 vel: areas area
3d60: 72 75 6e 73 20 72 75 6e 20 74 65 73 74 73 20 74 runs run tests t
3d70: 65 73 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 est.;;.(define (
3d80: 64 62 6f 61 72 64 3a 67 65 74 2d 76 69 65 77 2d dboard:get-view-
3d90: 74 79 70 65 20 6b 65 79 73 20 63 75 72 72 65 6e type keys curren
3da0: 74 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 2a 20 t-path). (let*
3db0: 28 28 70 61 74 68 2d 70 61 72 74 73 20 28 73 74 ((path-parts (st
3dc0: 72 69 6e 67 2d 73 70 6c 69 74 20 63 75 72 72 65 ring-split curre
3dd0: 6e 74 2d 70 61 74 68 20 22 2f 22 29 29 0a 09 20 nt-path "/"))..
3de0: 28 70 61 74 68 2d 6c 65 6e 20 20 20 28 6c 65 6e (path-len (len
3df0: 67 74 68 20 70 61 74 68 2d 70 61 72 74 73 29 29 gth path-parts))
3e00: 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 ). (cond.
3e10: 20 28 28 65 71 75 61 6c 3f 20 63 75 72 72 65 6e ((equal? curren
3e20: 74 2d 70 61 74 68 20 22 41 72 65 61 73 22 29 20 t-path "Areas")
3e30: 20 20 20 20 27 61 72 65 61 73 29 0a 20 20 20 20 'areas).
3e40: 20 28 28 65 71 3f 20 70 61 74 68 2d 6c 65 6e 20 ((eq? path-len
3e50: 32 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2)
3e60: 20 20 20 20 27 61 72 65 61 29 0a 20 20 20 20 20 'area).
3e70: 28 28 3c 3d 20 28 2b 20 28 6c 65 6e 67 74 68 20 ((<= (+ (length
3e80: 6b 65 79 73 29 20 32 29 20 70 61 74 68 2d 6c 65 keys) 2) path-le
3e90: 6e 29 20 27 72 75 6e 73 29 0a 20 20 20 20 20 28 n) 'runs). (
3ea0: 65 6c 73 65 20 20 20 20 20 20 20 20 20 20 20 20 else
3eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ec0: 20 20 27 72 75 6e 29 29 29 29 0a 0a 28 64 65 66 'run))))..(def
3ed0: 69 6e 65 20 28 64 62 6f 61 72 64 3a 63 6c 65 61 ine (dboard:clea
3ee0: 72 2d 6d 61 74 72 69 78 20 74 61 62 29 0a 20 20 r-matrix tab).
3ef0: 28 69 66 20 74 61 62 0a 20 20 20 20 20 20 28 62 (if tab. (b
3f00: 65 67 69 6e 0a 09 28 69 75 70 3a 61 74 74 72 69 egin..(iup:attri
3f10: 62 75 74 65 2d 73 65 74 21 20 28 74 61 62 2d 6d bute-set! (tab-m
3f20: 61 74 72 69 78 20 74 61 62 29 20 22 43 4c 45 41 atrix tab) "CLEA
3f30: 52 56 41 4c 55 45 22 20 22 41 4c 4c 22 29 0a 09 RVALUE" "ALL")..
3f40: 28 74 61 62 2d 68 65 61 64 65 72 73 2d 73 65 74 (tab-headers-set
3f50: 21 20 74 61 62 20 28 6d 61 6b 65 2d 68 61 73 68 ! tab (make-hash
3f60: 2d 74 61 62 6c 65 29 29 0a 09 28 74 61 62 2d 72 -table))..(tab-r
3f70: 6f 77 73 2d 73 65 74 21 20 20 20 20 74 61 62 20 ows-set! tab
3f80: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
3f90: 29 29 29 29 29 0a 0a 3b 3b 20 66 75 6c 6c 20 72 )))))..;; full r
3fa0: 65 64 72 61 77 20 6f 66 20 61 20 67 69 76 65 6e edraw of a given
3fb0: 20 61 72 65 61 0a 3b 3b 0a 28 64 65 66 69 6e 65 area.;;.(define
3fc0: 20 28 64 62 6f 61 72 64 3a 72 65 64 72 61 77 2d (dboard:redraw-
3fd0: 61 72 65 61 20 61 72 65 61 2d 6e 61 6d 65 20 61 area area-name a
3fe0: 72 65 61 2d 64 61 74 20 74 61 62 2d 64 61 74 20 rea-dat tab-dat
3ff0: 63 75 72 72 65 6e 74 2d 6d 61 74 72 69 78 20 63 current-matrix c
4000: 75 72 72 65 6e 74 2d 70 61 74 68 29 0a 20 20 28 urrent-path). (
4010: 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 20 20 let* ((keys
4020: 20 28 61 72 65 61 64 61 74 2d 72 75 6e 2d 6b 65 (areadat-run-ke
4030: 79 73 20 61 72 65 61 2d 64 61 74 29 29 0a 09 20 ys area-dat))..
4040: 28 72 75 6e 73 20 20 20 20 20 20 28 61 72 65 61 (runs (area
4050: 64 61 74 2d 72 75 6e 73 20 20 20 20 20 61 72 65 dat-runs are
4060: 61 2d 64 61 74 29 29 0a 09 20 28 68 65 61 64 65 a-dat)).. (heade
4070: 72 73 20 20 20 28 74 61 62 2d 68 65 61 64 65 72 rs (tab-header
4080: 73 20 20 20 74 61 62 2d 64 61 74 29 29 0a 09 20 s tab-dat))..
4090: 28 72 6f 77 73 20 20 20 20 20 20 28 74 61 62 2d (rows (tab-
40a0: 72 6f 77 73 20 20 20 20 20 20 74 61 62 2d 64 61 rows tab-da
40b0: 74 29 29 0a 09 20 28 75 73 65 64 2d 63 6f 6c 73 t)).. (used-cols
40c0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 76 61 6c (hash-table-val
40d0: 75 65 73 20 68 65 61 64 65 72 73 29 29 0a 09 20 ues headers))..
40e0: 28 75 73 65 64 2d 72 6f 77 73 20 28 68 61 73 68 (used-rows (hash
40f0: 2d 74 61 62 6c 65 2d 76 61 6c 75 65 73 20 72 6f -table-values ro
4100: 77 73 29 29 0a 09 20 28 74 6f 75 63 68 65 64 20 ws)).. (touched
4110: 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 (make-hash-tab
4120: 6c 65 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 20 le)) ;; (vector
4130: 72 6f 77 20 63 6f 6c 29 20 3d 3d 3e 20 74 72 75 row col) ==> tru
4140: 65 2c 20 74 6f 75 63 68 65 64 20 63 65 6c 6c 0a e, touched cell.
4150: 09 20 28 76 69 65 77 2d 74 79 70 65 20 28 64 62 . (view-type (db
4160: 6f 61 72 64 3a 67 65 74 2d 76 69 65 77 2d 74 79 oard:get-view-ty
4170: 70 65 20 6b 65 79 73 20 63 75 72 72 65 6e 74 2d pe keys current-
4180: 70 61 74 68 29 29 0a 09 20 28 63 68 61 6e 67 65 path)).. (change
4190: 64 20 20 20 23 66 29 0a 09 20 28 73 74 61 74 65 d #f).. (state
41a0: 2d 73 74 61 74 75 73 65 73 20 20 28 6c 69 73 74 -statuses (list
41b0: 20 22 50 41 53 53 22 20 22 46 41 49 4c 22 20 22 "PASS" "FAIL" "
41c0: 57 41 52 4e 22 20 22 43 48 45 43 4b 22 20 22 53 WARN" "CHECK" "S
41d0: 4b 49 50 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 KIP" "RUNNING" "
41e0: 4c 41 55 4e 43 48 45 44 22 29 29 29 0a 20 20 20 LAUNCHED"))).
41f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
4200: 22 63 75 72 72 65 6e 74 2d 6d 61 74 72 69 78 3d "current-matrix=
4210: 22 20 63 75 72 72 65 6e 74 2d 6d 61 74 72 69 78 " current-matrix
4220: 29 0a 20 20 20 20 28 63 61 73 65 20 76 69 65 77 ). (case view
4230: 2d 74 79 70 65 0a 20 20 20 20 20 20 28 28 61 72 -type. ((ar
4240: 65 61 73 29 20 3b 3b 20 66 69 6e 64 20 72 6f 77 eas) ;; find row
4250: 20 66 6f 72 20 74 68 69 73 20 61 72 65 61 2c 20 for this area,
4260: 69 66 20 6e 6f 74 20 66 6f 75 6e 64 2c 20 63 72 if not found, cr
4270: 65 61 74 65 20 6e 65 77 20 65 6e 74 72 79 0a 20 eate new entry.
4280: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 75 (let* ((cu
4290: 72 72 2d 72 6f 77 6e 75 6d 20 28 68 61 73 68 2d rr-rownum (hash-
42a0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
42b0: 74 20 72 6f 77 73 20 61 72 65 61 2d 6e 61 6d 65 t rows area-name
42c0: 20 23 66 29 29 0a 09 20 20 20 20 20 20 28 6e 65 #f)).. (ne
42d0: 78 74 2d 72 6f 77 6e 75 6d 20 28 2b 20 28 61 70 xt-rownum (+ (ap
42e0: 70 6c 79 20 6d 61 78 20 28 63 6f 6e 73 20 30 20 ply max (cons 0
42f0: 75 73 65 64 2d 72 6f 77 73 29 29 20 31 29 29 0a used-rows)) 1)).
4300: 09 20 20 20 20 20 20 28 72 6f 77 6e 75 6d 20 20 . (rownum
4310: 20 20 20 20 28 6f 72 20 63 75 72 72 2d 72 6f 77 (or curr-row
4320: 6e 75 6d 20 6e 65 78 74 2d 72 6f 77 6e 75 6d 29 num next-rownum)
4330: 29 0a 09 20 20 20 20 20 20 28 63 6f 6f 72 64 20 ).. (coord
4340: 20 20 20 20 20 20 28 63 6f 6e 63 20 72 6f 77 6e (conc rown
4350: 75 6d 20 22 3a 30 22 29 29 29 0a 09 20 28 69 66 um ":0"))).. (if
4360: 20 28 6e 6f 74 20 63 75 72 72 2d 72 6f 77 6e 75 (not curr-rownu
4370: 6d 29 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 m)(hash-table-se
4380: 74 21 20 72 6f 77 73 20 61 72 65 61 2d 6e 61 6d t! rows area-nam
4390: 65 20 72 6f 77 6e 75 6d 29 29 0a 09 20 28 69 66 e rownum)).. (if
43a0: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 69 (not (equal? (i
43b0: 75 70 3a 61 74 74 72 69 62 75 74 65 20 63 75 72 up:attribute cur
43c0: 72 65 6e 74 2d 6d 61 74 72 69 78 20 63 6f 6f 72 rent-matrix coor
43d0: 64 29 20 61 72 65 61 2d 6e 61 6d 65 29 29 0a 09 d) area-name))..
43e0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 (begin..
43f0: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
4400: 68 65 64 20 20 28 63 61 72 20 73 74 61 74 65 2d hed (car state-
4410: 73 74 61 74 75 73 65 73 29 29 0a 09 09 09 20 20 statuses))....
4420: 28 74 61 6c 20 20 28 63 64 72 20 73 74 61 74 65 (tal (cdr state
4430: 2d 73 74 61 74 75 73 65 73 29 29 0a 09 09 09 20 -statuses))....
4440: 20 28 63 6f 75 6e 74 20 31 29 29 0a 09 09 20 28 (count 1))... (
4450: 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 if (not (equal?
4460: 28 69 75 70 3a 61 74 74 72 69 62 75 74 65 20 63 (iup:attribute c
4470: 75 72 72 65 6e 74 2d 6d 61 74 72 69 78 20 28 63 urrent-matrix (c
4480: 6f 6e 63 20 22 30 3a 22 20 63 6f 75 6e 74 29 29 onc "0:" count))
4490: 20 68 65 64 29 29 0a 09 09 20 20 20 20 20 28 69 hed))... (i
44a0: 75 70 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 up:attribute-set
44b0: 21 20 63 75 72 72 65 6e 74 2d 6d 61 74 72 69 78 ! current-matrix
44c0: 20 28 63 6f 6e 63 20 22 30 3a 22 20 63 6f 75 6e (conc "0:" coun
44d0: 74 29 20 68 65 64 29 29 0a 09 09 20 28 69 75 70 t) hed))... (iup
44e0: 3a 61 74 74 72 69 62 75 74 65 2d 73 65 74 21 20 :attribute-set!
44f0: 63 75 72 72 65 6e 74 2d 6d 61 74 72 69 78 20 28 current-matrix (
4500: 63 6f 6e 63 20 72 6f 77 6e 75 6d 20 22 3a 22 20 conc rownum ":"
4510: 63 6f 75 6e 74 29 20 22 30 22 29 0a 09 09 20 28 count) "0")... (
4520: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 if (not (null? t
4530: 61 6c 29 29 0a 09 09 20 20 20 20 20 28 6c 6f 6f al))... (loo
4540: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
4550: 74 61 6c 29 28 2b 20 63 6f 75 6e 74 20 31 29 29 tal)(+ count 1))
4560: 29 29 0a 09 20 20 20 20 20 20 20 28 64 65 62 75 )).. (debu
4570: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 g:print-info 0 "
4580: 76 69 65 77 2d 74 79 70 65 3d 22 20 76 69 65 77 view-type=" view
4590: 2d 74 79 70 65 20 22 2c 20 72 6f 77 6e 75 6d 3d -type ", rownum=
45a0: 22 20 72 6f 77 6e 75 6d 20 22 2c 20 63 75 72 72 " rownum ", curr
45b0: 2d 72 6f 77 6e 75 6d 3d 22 20 63 75 72 72 2d 72 -rownum=" curr-r
45c0: 6f 77 6e 75 6d 20 22 2c 20 6e 65 78 74 2d 72 6f ownum ", next-ro
45d0: 77 6e 75 6d 3d 22 20 6e 65 78 74 2d 72 6f 77 6e wnum=" next-rown
45e0: 75 6d 20 22 2c 20 63 6f 6f 72 64 3d 22 20 63 6f um ", coord=" co
45f0: 6f 72 64 20 22 2c 20 61 72 65 61 2d 6e 61 6d 65 ord ", area-name
4600: 3d 22 20 61 72 65 61 2d 6e 61 6d 65 29 0a 09 20 =" area-name)..
4610: 20 20 20 20 20 20 28 69 75 70 3a 61 74 74 72 69 (iup:attri
4620: 62 75 74 65 2d 73 65 74 21 20 63 75 72 72 65 6e bute-set! curren
4630: 74 2d 6d 61 74 72 69 78 20 63 6f 6f 72 64 20 61 t-matrix coord a
4640: 72 65 61 2d 6e 61 6d 65 29 0a 09 20 20 20 20 20 rea-name)..
4650: 20 20 28 73 65 74 21 20 63 68 61 6e 67 65 64 20 (set! changed
4660: 23 74 29 29 29 29 29 29 0a 20 20 20 20 28 69 66 #t)))))). (if
4670: 20 63 68 61 6e 67 65 64 20 28 69 75 70 3a 61 74 changed (iup:at
4680: 74 72 69 62 75 74 65 2d 73 65 74 21 20 63 75 72 tribute-set! cur
4690: 72 65 6e 74 2d 6d 61 74 72 69 78 20 22 52 45 44 rent-matrix "RED
46a0: 52 41 57 22 20 22 41 4c 4c 22 29 29 29 29 0a 09 RAW" "ALL"))))..
46b0: 20 20 20 20 20 0a 0a 20 20 20 20 20 20 20 0a 20 .. .
46c0: 20 20 3b 3b 20 28 64 62 6f 61 72 64 3a 63 6c 65 ;; (dboard:cle
46d0: 61 72 2d 6d 61 74 72 69 78 20 63 75 72 72 65 6e ar-matrix curren
46e0: 74 2d 6d 61 74 72 69 78 20 75 73 65 64 2d 63 6f t-matrix used-co
46f0: 6c 73 20 75 73 65 64 2d 72 6f 77 73 20 74 6f 75 ls used-rows tou
4700: 63 68 65 64 29 20 3b 3b 20 63 6c 65 61 72 20 61 ched) ;; clear a
4710: 6c 6c 0a 20 20 20 20 0a 09 0a 20 20 0a 3b 3b 3d ll. ... .;;=
4720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4760: 3d 3d 3d 3d 3d 0a 3b 3b 20 44 20 41 20 53 20 48 =====.;; D A S H
4770: 20 42 20 4f 20 41 20 52 20 44 0a 3b 3b 3d 3d 3d B O A R D.;;===
4780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
47a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
47b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
47c0: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 61 ===..(define (da
47d0: 73 68 62 6f 61 72 64 3a 61 72 65 61 2d 70 61 6e shboard:area-pan
47e0: 65 6c 20 61 6e 61 6d 65 20 64 61 74 61 20 77 69 el aname data wi
47f0: 6e 64 6f 77 2d 69 64 29 0a 20 20 28 6c 65 74 2a ndow-id). (let*
4800: 20 28 28 61 70 61 74 68 20 20 20 20 20 20 28 63 ((apath (c
4810: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 28 64 onfigf:lookup (d
4820: 61 74 61 2d 63 66 67 64 61 74 20 64 61 74 61 29 ata-cfgdat data)
4830: 20 61 6e 61 6d 65 20 22 70 61 74 68 22 29 29 20 aname "path"))
4840: 3b 3b 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ;; (hash-table-
4850: 72 65 66 20 28 64 62 6f 61 72 64 3a 64 61 74 61 ref (dboard:data
4860: 2d 63 66 67 64 61 74 20 64 61 74 61 29 20 61 72 -cfgdat data) ar
4870: 65 61 2d 6e 61 6d 65 29 29 0a 09 20 3b 3b 20 20 ea-name)).. ;;
4880: 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 (hash-ta
4890: 62 6c 65 2d 72 65 66 20 28 64 62 6f 61 72 64 3a ble-ref (dboard:
48a0: 64 61 74 61 2d 63 66 67 64 61 74 20 64 61 74 61 data-cfgdat data
48b0: 29 20 61 6e 61 6d 65 29 29 0a 09 20 28 61 72 65 ) aname)).. (are
48c0: 61 2d 64 61 74 20 20 20 28 64 61 73 68 62 6f 61 a-dat (dashboa
48d0: 72 64 3a 69 6e 69 74 2d 61 72 65 61 20 64 61 74 rd:init-area dat
48e0: 61 20 61 6e 61 6d 65 20 61 70 61 74 68 29 29 0a a aname apath)).
48f0: 09 20 28 74 62 20 20 20 20 20 20 20 20 20 28 64 . (tb (d
4900: 61 73 68 62 6f 61 72 64 3a 74 72 65 65 2d 62 72 ashboard:tree-br
4910: 6f 77 73 65 72 20 64 61 74 61 20 61 72 65 61 2d owser data area-
4920: 64 61 74 20 77 69 6e 64 6f 77 2d 69 64 29 29 20 dat window-id))
4930: 3b 3b 20 28 64 62 6f 61 72 64 3a 61 72 65 61 73 ;; (dboard:areas
4940: 2d 74 72 65 65 2d 62 72 6f 77 73 65 72 20 64 61 -tree-browser da
4950: 74 61 29 0a 09 20 28 61 64 20 20 20 20 20 20 20 ta).. (ad
4960: 20 20 28 64 61 73 68 62 6f 61 72 64 3a 6d 61 69 (dashboard:mai
4970: 6e 2d 6d 61 74 72 69 78 20 20 64 61 74 61 20 61 n-matrix data a
4980: 72 65 61 2d 64 61 74 20 77 69 6e 64 6f 77 2d 69 rea-dat window-i
4990: 64 29 29 0a 09 20 28 61 72 65 61 73 20 20 20 20 d)).. (areas
49a0: 20 20 28 64 61 74 61 2d 61 72 65 61 73 20 64 61 (data-areas da
49b0: 74 61 29 29 0a 09 20 28 64 62 6f 61 72 64 2d 64 ta)).. (dboard-d
49c0: 61 74 20 28 6d 61 6b 65 2d 74 61 62 0a 09 09 20 at (make-tab...
49d0: 20 20 20 20 20 23 66 20 20 20 20 20 20 20 20 20 #f
49e0: 20 20 3b 3b 20 74 72 65 65 0a 09 09 20 20 20 20 ;; tree...
49f0: 20 20 23 66 20 20 20 20 20 20 20 20 20 20 20 3b #f ;
4a00: 3b 20 6d 61 74 72 69 78 0a 09 09 20 20 20 20 20 ; matrix...
4a10: 20 61 72 65 61 2d 64 61 74 20 20 20 20 20 3b 3b area-dat ;;
4a20: 0a 09 09 20 20 20 20 20 20 23 66 20 20 20 20 20 ... #f
4a30: 20 20 20 20 20 20 3b 3b 20 76 69 65 77 20 70 61 ;; view pa
4a40: 74 68 0a 09 09 20 20 20 20 20 20 27 64 65 66 61 th... 'defa
4a50: 75 6c 74 20 20 20 20 20 3b 3b 20 76 69 65 77 20 ult ;; view
4a60: 74 79 70 65 0a 09 09 20 20 20 20 20 20 23 66 20 type... #f
4a70: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 63 6f 6e ;; con
4a80: 74 72 6f 6c 73 0a 09 09 20 20 20 20 20 20 28 6d trols... (m
4a90: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 ake-hash-table)
4aa0: 3b 3b 20 63 61 63 68 65 64 20 64 61 74 61 3f 20 ;; cached data?
4ab0: 6e 6f 74 20 73 75 72 65 20 68 6f 77 20 74 6f 20 not sure how to
4ac0: 75 73 65 20 74 68 69 73 20 79 65 74 20 3a 29 0a use this yet :).
4ad0: 09 09 20 20 20 20 20 20 23 66 20 20 20 20 20 20 .. #f
4ae0: 20 20 20 20 20 3b 3b 20 66 69 6c 74 65 72 73 0a ;; filters.
4af0: 09 09 20 20 20 20 20 20 23 66 20 20 20 20 20 20 .. #f
4b00: 20 20 20 20 20 3b 3b 20 74 68 65 20 72 75 6e 2d ;; the run-
4b10: 69 64 0a 09 09 20 20 20 20 20 20 28 6d 61 6b 65 id... (make
4b20: 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 3b 3b 20 -hash-table) ;;
4b30: 72 75 6e 2d 69 64 20 2d 3e 20 74 65 73 74 2d 69 run-id -> test-i
4b40: 64 2c 20 66 6f 72 20 63 75 72 72 65 6e 74 20 74 d, for current t
4b50: 65 73 74 20 69 64 0a 09 09 20 20 20 20 20 20 22 est id... "
4b60: 22 0a 09 09 20 20 20 20 20 20 28 6d 61 6b 65 2d "... (make-
4b70: 68 61 73 68 2d 74 61 62 6c 65 29 20 3b 3b 20 68 hash-table) ;; h
4b80: 65 61 64 65 72 6e 61 6d 65 20 2d 3e 20 63 6f 6c eadername -> col
4b90: 6e 75 6d 0a 09 09 20 20 20 20 20 20 28 6d 61 6b num... (mak
4ba0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 3b 3b e-hash-table) ;;
4bb0: 20 72 6f 77 6e 61 6d 65 20 20 20 20 2d 3e 20 72 rowname -> r
4bc0: 6f 77 6e 75 6d 0a 09 09 20 20 20 20 20 20 29 29 ownum... ))
4bd0: 29 0a 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c ). (hash-tabl
4be0: 65 2d 73 65 74 21 20 28 64 61 74 61 2d 61 72 65 e-set! (data-are
4bf0: 61 73 20 64 61 74 61 29 20 61 6e 61 6d 65 20 61 as data) aname a
4c00: 72 65 61 2d 64 61 74 29 20 3b 3b 20 64 62 6f 61 rea-dat) ;; dboa
4c10: 72 64 2d 64 61 74 29 0a 20 20 20 20 28 68 61 73 rd-dat). (has
4c20: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 28 64 61 h-table-set! (da
4c30: 74 61 2d 74 61 62 73 20 64 61 74 61 29 20 77 69 ta-tabs data) wi
4c40: 6e 64 6f 77 2d 69 64 20 64 62 6f 61 72 64 2d 64 ndow-id dboard-d
4c50: 61 74 29 0a 20 20 20 20 28 74 61 62 2d 74 72 65 at). (tab-tre
4c60: 65 2d 73 65 74 21 20 20 20 64 62 6f 61 72 64 2d e-set! dboard-
4c70: 64 61 74 20 74 62 29 0a 20 20 20 20 28 74 61 62 dat tb). (tab
4c80: 2d 6d 61 74 72 69 78 2d 73 65 74 21 20 64 62 6f -matrix-set! dbo
4c90: 61 72 64 2d 64 61 74 20 61 64 29 0a 20 20 20 20 ard-dat ad).
4ca0: 28 69 75 70 3a 73 70 6c 69 74 0a 20 20 20 20 20 (iup:split.
4cb0: 23 3a 76 61 6c 75 65 20 32 30 30 0a 20 20 20 20 #:value 200.
4cc0: 20 74 62 20 61 64 29 29 29 0a 0a 0a 3b 3b 20 4d tb ad)))...;; M
4cd0: 61 69 6e 20 50 61 6e 65 6c 0a 3b 3b 0a 28 64 65 ain Panel.;;.(de
4ce0: 66 69 6e 65 20 28 64 61 73 68 62 6f 61 72 64 3a fine (dashboard:
4cf0: 6d 61 69 6e 2d 70 61 6e 65 6c 20 64 61 74 61 20 main-panel data
4d00: 77 69 6e 64 6f 77 2d 69 64 29 0a 20 20 28 69 75 window-id). (iu
4d10: 70 3a 64 69 61 6c 6f 67 0a 20 20 20 23 3a 74 69 p:dialog. #:ti
4d20: 74 6c 65 20 22 4d 65 67 61 74 65 73 74 20 43 6f tle "Megatest Co
4d30: 6e 74 72 6f 6c 20 50 61 6e 65 6c 22 0a 3b 3b 20 ntrol Panel".;;
4d40: 20 20 23 3a 6d 65 6e 75 20 28 64 63 6f 6d 6d 6f #:menu (dcommo
4d50: 6e 3a 6d 61 69 6e 2d 6d 65 6e 75 20 64 61 74 61 n:main-menu data
4d60: 29 0a 20 20 20 23 3a 73 68 72 69 6e 6b 20 22 59 ). #:shrink "Y
4d70: 45 53 22 0a 20 20 20 28 69 75 70 3a 76 62 6f 78 ES". (iup:vbox
4d80: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 61 72 65 . (let* ((are
4d90: 61 2d 6e 61 6d 65 73 20 20 28 68 61 73 68 2d 74 a-names (hash-t
4da0: 61 62 6c 65 2d 6b 65 79 73 20 28 64 61 74 61 2d able-keys (data-
4db0: 63 66 67 64 61 74 20 64 61 74 61 29 29 29 0a 09 cfgdat data)))..
4dc0: 20 20 20 28 61 72 65 61 2d 70 61 6e 65 6c 73 20 (area-panels
4dd0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 61 6e (map (lambda (an
4de0: 61 6d 65 29 0a 09 09 09 20 20 20 20 20 20 20 28 ame).... (
4df0: 64 61 73 68 62 6f 61 72 64 3a 61 72 65 61 2d 70 dashboard:area-p
4e00: 61 6e 65 6c 20 61 6e 61 6d 65 20 64 61 74 61 20 anel aname data
4e10: 77 69 6e 64 6f 77 2d 69 64 29 29 0a 09 09 09 20 window-id))....
4e20: 20 20 20 20 61 72 65 61 2d 6e 61 6d 65 73 29 29 area-names))
4e30: 0a 09 20 20 20 28 74 61 62 74 6f 70 20 20 20 20 .. (tabtop
4e40: 20 20 28 61 70 70 6c 79 20 69 75 70 3a 74 61 62 (apply iup:tab
4e50: 73 20 20 0a 09 09 09 20 20 20 20 20 20 20 23 3a s .... #:
4e60: 74 61 62 63 68 61 6e 67 65 70 6f 73 2d 63 62 20 tabchangepos-cb
4e70: 28 6c 61 6d 62 64 61 20 28 6f 62 6a 20 63 75 72 (lambda (obj cur
4e80: 72 20 70 72 65 76 29 0a 09 09 09 09 09 09 20 20 r prev).......
4e90: 20 28 64 61 74 61 2d 63 75 72 72 65 6e 74 2d 74 (data-current-t
4ea0: 61 62 2d 69 64 2d 73 65 74 21 20 64 61 74 61 20 ab-id-set! data
4eb0: 63 75 72 72 29 0a 09 09 09 09 09 09 20 20 20 28 curr)....... (
4ec0: 64 61 74 61 2d 75 70 64 61 74 65 2d 6e 65 65 64 data-update-need
4ed0: 65 64 2d 73 65 74 21 20 20 64 61 74 61 20 23 74 ed-set! data #t
4ee0: 29 0a 09 09 09 09 09 09 20 20 20 28 70 72 69 6e )....... (prin
4ef0: 74 20 22 54 61 62 20 69 73 3a 20 22 20 63 75 72 t "Tab is: " cur
4f00: 72 20 22 2c 20 70 72 65 76 20 77 61 73 20 22 20 r ", prev was "
4f10: 70 72 65 76 29 29 0a 09 09 09 20 20 20 20 20 20 prev))....
4f20: 20 61 72 65 61 2d 70 61 6e 65 6c 73 29 29 0a 09 area-panels))..
4f30: 20 20 20 28 74 61 62 73 20 20 20 20 20 28 64 61 (tabs (da
4f40: 74 61 2d 74 61 62 73 20 64 61 74 61 29 29 29 0a ta-tabs data))).
4f50: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
4f60: 6e 75 6c 6c 3f 20 61 72 65 61 2d 6e 61 6d 65 73 null? area-names
4f70: 29 29 0a 09 20 20 28 6c 65 74 20 6c 6f 6f 70 20 )).. (let loop
4f80: 28 28 69 6e 64 65 78 20 30 29 0a 09 09 20 20 20 ((index 0)...
4f90: 20 20 28 68 65 64 20 20 20 28 63 61 72 20 61 72 (hed (car ar
4fa0: 65 61 2d 6e 61 6d 65 73 29 29 0a 09 09 20 20 20 ea-names))...
4fb0: 20 20 28 74 61 6c 20 20 20 28 63 64 72 20 61 72 (tal (cdr ar
4fc0: 65 61 2d 6e 61 6d 65 73 29 29 29 0a 09 20 20 20 ea-names)))..
4fd0: 20 3b 3b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ;; (hash-table-
4fe0: 73 65 74 21 20 74 61 62 73 20 69 6e 64 65 78 20 set! tabs index
4ff0: 68 65 64 29 0a 09 20 20 20 20 28 64 65 62 75 67 hed).. (debug
5000: 3a 70 72 69 6e 74 20 30 20 22 41 64 64 69 6e 67 :print 0 "Adding
5010: 20 61 72 65 61 20 22 20 68 65 64 20 22 20 77 69 area " hed " wi
5020: 74 68 20 69 6e 64 65 78 20 22 20 69 6e 64 65 78 th index " index
5030: 20 22 20 74 6f 20 64 61 73 68 62 6f 61 72 64 22 " to dashboard"
5040: 29 0a 09 20 20 20 20 28 69 75 70 3a 61 74 74 72 ).. (iup:attr
5050: 69 62 75 74 65 2d 73 65 74 21 20 74 61 62 74 6f ibute-set! tabto
5060: 70 20 28 63 6f 6e 63 20 22 54 41 42 54 49 54 4c p (conc "TABTITL
5070: 45 22 20 69 6e 64 65 78 29 20 68 65 64 29 0a 09 E" index) hed)..
5080: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 (if (not (nu
5090: 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 28 6c 6f 6f ll? tal))...(loo
50a0: 70 20 28 2b 20 69 6e 64 65 78 20 31 29 28 63 61 p (+ index 1)(ca
50b0: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 29 r tal)(cdr tal))
50c0: 29 29 29 0a 20 20 20 20 20 20 74 61 62 74 6f 70 ))). tabtop
50d0: 29 29 29 29 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ))))...;;=======
50e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
50f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
5120: 3b 3b 20 4e 20 41 20 4e 20 4f 20 4d 20 53 20 47 ;; N A N O M S G
5130: 20 20 20 53 20 45 20 52 20 56 20 45 20 52 0a 3b S E R V E R.;
5140: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5180: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
5190: 20 28 64 62 6f 61 72 64 3a 73 65 72 76 65 72 2d (dboard:server-
51a0: 73 65 72 76 69 63 65 20 73 6f 63 20 70 6f 72 74 service soc port
51b0: 29 0a 20 20 28 70 72 69 6e 74 20 22 73 65 72 76 ). (print "serv
51c0: 65 72 20 73 74 61 72 74 69 6e 67 22 29 0a 20 20 er starting").
51d0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6d 73 67 2d (let loop ((msg-
51e0: 69 6e 20 28 6e 6e 2d 72 65 63 76 20 73 6f 63 29 in (nn-recv soc)
51f0: 29 0a 09 20 20 20 20 20 28 63 6f 75 6e 74 20 20 ).. (count
5200: 30 29 29 0a 20 20 20 20 28 69 66 20 28 65 71 3f 0)). (if (eq?
5210: 20 30 20 28 6d 6f 64 75 6c 6f 20 63 6f 75 6e 74 0 (modulo count
5220: 20 31 30 30 30 29 29 0a 09 28 70 72 69 6e 74 20 1000))..(print
5230: 22 73 65 72 76 65 72 20 72 65 63 65 69 76 65 64 "server received
5240: 3a 20 22 20 6d 73 67 2d 69 6e 20 22 2c 20 63 6f : " msg-in ", co
5250: 75 6e 74 3d 22 20 63 6f 75 6e 74 29 29 0a 20 20 unt=" count)).
5260: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 3b 3b 0a (cond. ;;.
5270: 20 20 20 20 20 3b 3b 20 71 75 69 74 0a 20 20 20 ;; quit.
5280: 20 20 3b 3b 0a 20 20 20 20 20 28 28 65 71 75 61 ;;. ((equa
5290: 6c 3f 20 6d 73 67 2d 69 6e 20 22 71 75 69 74 22 l? msg-in "quit"
52a0: 29 0a 20 20 20 20 20 20 28 6e 6e 2d 73 65 6e 64 ). (nn-send
52b0: 20 73 6f 63 20 22 4f 6b 2c 20 71 75 69 74 74 69 soc "Ok, quitti
52c0: 6e 67 22 29 29 0a 20 20 20 20 20 3b 3b 0a 20 20 ng")). ;;.
52d0: 20 20 20 3b 3b 20 70 69 6e 67 0a 20 20 20 20 20 ;; ping.
52e0: 3b 3b 0a 20 20 20 20 20 28 28 61 6e 64 20 28 3e ;;. ((and (>
52f0: 3d 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 = (string-length
5300: 20 6d 73 67 2d 69 6e 29 20 34 29 0a 09 20 20 20 msg-in) 4)..
5310: 28 65 71 75 61 6c 3f 20 28 73 75 62 73 74 72 69 (equal? (substri
5320: 6e 67 20 6d 73 67 2d 69 6e 20 30 20 34 29 20 22 ng msg-in 0 4) "
5330: 70 69 6e 67 22 29 29 0a 20 20 20 20 20 20 28 6e ping")). (n
5340: 6e 2d 73 65 6e 64 20 73 6f 63 20 28 63 6f 6e 63 n-send soc (conc
5350: 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 (current-proces
5360: 73 2d 69 64 29 29 29 0a 20 20 20 20 20 20 28 6c s-id))). (l
5370: 6f 6f 70 20 28 6e 6e 2d 72 65 63 76 20 73 6f 63 oop (nn-recv soc
5380: 29 28 2b 20 63 6f 75 6e 74 20 31 29 29 29 0a 20 )(+ count 1))).
5390: 20 20 20 20 3b 3b 0a 20 20 20 20 20 3b 3b 20 6d ;;. ;; m
53a0: 61 69 6e 20 63 68 61 6e 67 65 64 0a 20 20 20 20 ain changed.
53b0: 20 3b 3b 0a 20 20 20 20 20 28 28 61 6e 64 20 28 ;;. ((and (
53c0: 3e 3d 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 >= (string-lengt
53d0: 68 20 6d 73 67 2d 69 6e 29 20 34 29 0a 09 20 20 h msg-in) 4)..
53e0: 20 28 65 71 75 61 6c 3f 20 28 73 75 62 73 74 72 (equal? (substr
53f0: 69 6e 67 20 6d 73 67 2d 69 6e 20 30 20 34 29 20 ing msg-in 0 4)
5400: 22 6d 61 69 6e 22 29 29 0a 20 20 20 20 20 20 28 "main")). (
5410: 6c 65 74 20 28 28 70 61 72 74 73 20 28 73 74 72 let ((parts (str
5420: 69 6e 67 2d 73 70 6c 69 74 20 6d 73 67 2d 69 6e ing-split msg-in
5430: 20 22 20 22 29 29 29 0a 09 28 68 61 73 68 2d 74 " ")))..(hash-t
5440: 61 62 6c 65 2d 73 65 74 21 20 2a 63 68 61 6e 67 able-set! *chang
5450: 65 64 2d 6d 61 69 6e 2a 20 28 63 61 64 72 20 70 ed-main* (cadr p
5460: 61 72 74 73 29 20 23 74 29 0a 09 28 6e 6e 2d 73 arts) #t)..(nn-s
5470: 65 6e 64 20 73 6f 63 20 22 67 6f 74 20 69 74 21 end soc "got it!
5480: 22 29 29 29 0a 20 20 20 20 20 3b 3b 0a 20 20 20 "))). ;;.
5490: 20 20 3b 3b 20 3f 3f 0a 20 20 20 20 20 3b 3b 0a ;; ??. ;;.
54a0: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
54b0: 20 28 6e 6e 2d 73 65 6e 64 20 73 6f 63 20 22 68 (nn-send soc "h
54c0: 65 6c 6c 6f 20 22 20 6d 73 67 2d 69 6e 20 22 20 ello " msg-in "
54d0: 79 6f 75 20 67 6f 74 20 74 6f 20 74 68 65 20 65 you got to the e
54e0: 6c 73 65 20 63 6c 61 75 73 65 21 22 29 29 29 0a lse clause!"))).
54f0: 20 20 20 20 28 6c 6f 6f 70 20 28 6e 6e 2d 72 65 (loop (nn-re
5500: 63 76 20 73 6f 63 29 28 69 66 20 28 3e 20 63 6f cv soc)(if (> co
5510: 75 6e 74 20 32 30 30 30 30 30 30 30 29 0a 09 09 unt 20000000)...
5520: 09 20 20 20 30 0a 09 09 09 20 20 20 28 2b 20 63 . 0.... (+ c
5530: 6f 75 6e 74 20 31 29 29 29 29 29 0a 0a 28 64 65 ount 1)))))..(de
5540: 66 69 6e 65 20 28 64 62 6f 61 72 64 3a 6f 6e 65 fine (dboard:one
5550: 2d 74 69 6d 65 2d 70 69 6e 67 2d 72 65 63 65 69 -time-ping-recei
5560: 76 65 20 73 6f 63 20 70 6f 72 74 29 0a 20 20 28 ve soc port). (
5570: 6c 65 74 20 28 28 6d 73 67 2d 69 6e 20 28 6e 6e let ((msg-in (nn
5580: 2d 72 65 63 76 20 73 6f 63 29 29 29 0a 20 20 20 -recv soc))).
5590: 20 28 69 66 20 28 61 6e 64 20 28 3e 3d 20 28 73 (if (and (>= (s
55a0: 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 6d 73 67 tring-length msg
55b0: 2d 69 6e 29 20 34 29 0a 09 20 20 20 20 20 28 65 -in) 4).. (e
55c0: 71 75 61 6c 3f 20 28 73 75 62 73 74 72 69 6e 67 qual? (substring
55d0: 20 6d 73 67 2d 69 6e 20 30 20 34 29 20 22 70 69 msg-in 0 4) "pi
55e0: 6e 67 22 29 29 0a 09 28 6e 6e 2d 73 65 6e 64 20 ng"))..(nn-send
55f0: 73 6f 63 20 28 63 6f 6e 63 20 28 63 75 72 72 65 soc (conc (curre
5600: 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 29 nt-process-id)))
5610: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 )))..(define (db
5620: 6f 61 72 64 3a 73 65 72 76 65 72 2d 73 74 61 72 oard:server-star
5630: 74 20 67 69 76 65 6e 2d 70 6f 72 74 20 23 21 6b t given-port #!k
5640: 65 79 20 28 6e 75 6d 2d 74 72 69 65 73 20 32 30 ey (num-tries 20
5650: 30 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 0)). (let* ((re
5660: 70 20 28 6e 6e 2d 73 6f 63 6b 65 74 20 27 72 65 p (nn-socket 're
5670: 70 29 29 0a 09 20 28 70 6f 72 74 20 28 6f 72 20 p)).. (port (or
5680: 67 69 76 65 6e 2d 70 6f 72 74 20 20 28 70 6f 72 given-port (por
5690: 74 6c 6f 67 67 65 72 3a 6d 61 69 6e 20 22 66 69 tlogger:main "fi
56a0: 6e 64 22 29 29 29 0a 09 20 28 63 6f 6e 20 28 63 nd"))).. (con (c
56b0: 6f 6e 63 20 22 74 63 70 3a 2f 2f 2a 3a 22 20 70 onc "tcp://*:" p
56c0: 6f 72 74 29 29 29 0a 20 20 20 20 3b 3b 20 72 65 ort))). ;; re
56d0: 67 69 73 74 65 72 20 74 68 69 73 20 63 6f 6e 6e gister this conn
56e0: 65 63 74 20 68 65 72 65 20 2e 2e 2e 2e 0a 20 20 ect here .....
56f0: 20 20 28 6e 6e 2d 62 69 6e 64 20 72 65 70 20 63 (nn-bind rep c
5700: 6f 6e 29 0a 20 20 20 20 28 74 68 72 65 61 64 2d on). (thread-
5710: 73 74 61 72 74 21 20 0a 20 20 20 20 20 28 6d 61 start! . (ma
5720: 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 64 ke-thread (lambd
5730: 61 20 28 29 0a 09 09 20 20 20 20 28 64 62 6f 61 a ()... (dboa
5740: 72 64 3a 6f 6e 65 2d 74 69 6d 65 2d 70 69 6e 67 rd:one-time-ping
5750: 2d 72 65 63 65 69 76 65 20 72 65 70 20 70 6f 72 -receive rep por
5760: 74 29 29 0a 09 09 20 20 22 6f 6e 65 20 74 69 6d t))... "one tim
5770: 65 20 72 65 63 65 69 76 65 20 74 68 72 65 61 64 e receive thread
5780: 22 29 29 0a 20 20 20 20 28 69 66 20 28 64 62 6f ")). (if (dbo
5790: 61 72 64 3a 70 69 6e 67 2d 73 65 6c 66 20 22 6c ard:ping-self "l
57a0: 6f 63 61 6c 68 6f 73 74 22 20 70 6f 72 74 29 0a ocalhost" port).
57b0: 09 28 62 65 67 69 6e 0a 09 20 20 28 70 72 69 6e .(begin.. (prin
57c0: 74 20 22 49 4e 46 4f 3a 20 64 61 73 68 62 6f 61 t "INFO: dashboa
57d0: 72 64 20 6e 61 6e 6f 6d 73 67 20 73 65 72 76 65 rd nanomsg serve
57e0: 72 20 73 74 61 72 74 65 64 20 6f 6e 20 22 20 70 r started on " p
57f0: 6f 72 74 29 0a 09 20 20 28 76 61 6c 75 65 73 20 ort).. (values
5800: 72 65 70 20 70 6f 72 74 29 29 0a 09 28 62 65 67 rep port))..(beg
5810: 69 6e 0a 09 20 20 28 70 72 69 6e 74 20 22 57 41 in.. (print "WA
5820: 52 4e 49 4e 47 3a 20 63 6f 75 6c 64 6e 27 74 20 RNING: couldn't
5830: 63 72 65 61 74 65 20 73 65 72 76 65 72 20 6f 6e create server on
5840: 20 70 6f 72 74 20 22 20 70 6f 72 74 29 0a 09 20 port " port)..
5850: 20 28 70 6f 72 74 6c 6f 67 67 65 72 3a 6d 61 69 (portlogger:mai
5860: 6e 20 22 73 65 74 22 20 22 66 61 69 6c 65 64 22 n "set" "failed"
5870: 29 0a 09 20 20 28 69 66 20 28 3e 20 6e 75 6d 2d ).. (if (> num-
5880: 74 72 69 65 73 20 30 29 0a 09 20 20 20 20 20 20 tries 0)..
5890: 28 64 62 6f 61 72 64 3a 73 65 72 76 65 72 2d 73 (dboard:server-s
58a0: 74 61 72 74 20 23 66 20 28 2d 20 6e 75 6d 2d 74 tart #f (- num-t
58b0: 72 69 65 73 20 31 29 29 0a 09 20 20 20 20 20 20 ries 1))..
58c0: 28 62 65 67 69 6e 0a 09 09 28 70 72 69 6e 74 20 (begin...(print
58d0: 22 45 52 52 4f 52 3a 20 66 61 69 6c 65 64 20 74 "ERROR: failed t
58e0: 6f 20 73 74 61 72 74 20 6e 61 6e 6f 6d 73 67 20 o start nanomsg
58f0: 73 65 72 76 65 72 22 29 0a 09 09 28 76 61 6c 75 server")...(valu
5900: 65 73 20 23 66 20 23 66 29 29 29 29 29 29 29 0a es #f #f))))))).
5910: 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 64 .(define (dboard
5920: 3a 73 65 72 76 65 72 2d 63 6c 6f 73 65 20 63 6f :server-close co
5930: 6e 20 70 6f 72 74 29 0a 20 20 28 6e 6e 2d 63 6c n port). (nn-cl
5940: 6f 73 65 20 63 6f 6e 29 0a 20 20 28 70 6f 72 74 ose con). (port
5950: 6c 6f 67 67 65 72 3a 6d 61 69 6e 20 22 73 65 74 logger:main "set
5960: 22 20 70 6f 72 74 20 22 72 65 6c 65 61 73 65 64 " port "released
5970: 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 "))..(define (db
5980: 6f 61 72 64 3a 70 69 6e 67 2d 73 65 6c 66 20 68 oard:ping-self h
5990: 6f 73 74 20 70 6f 72 74 20 23 21 6b 65 79 20 28 ost port #!key (
59a0: 72 65 74 75 72 6e 2d 73 6f 63 6b 65 74 20 23 74 return-socket #t
59b0: 29 29 0a 20 20 3b 3b 20 73 65 6e 64 20 61 20 72 )). ;; send a r
59c0: 61 6e 64 6f 6d 20 6e 75 6d 62 65 72 20 61 6c 6f andom number alo
59d0: 6e 67 20 77 69 74 68 20 70 69 64 20 61 6e 64 20 ng with pid and
59e0: 63 68 65 63 6b 20 74 68 61 74 20 77 65 20 67 65 check that we ge
59f0: 74 20 69 74 20 62 61 63 6b 0a 20 20 28 6c 65 74 t it back. (let
5a00: 2a 20 28 28 72 65 71 20 20 20 20 20 28 6e 6e 2d * ((req (nn-
5a10: 73 6f 63 6b 65 74 20 27 72 65 71 29 29 0a 09 20 socket 'req))..
5a20: 28 6b 65 79 20 20 20 20 20 22 70 69 6e 67 22 29 (key "ping")
5a30: 0a 09 20 28 73 75 63 63 65 73 73 20 23 66 29 0a .. (success #f).
5a40: 09 20 28 6b 65 65 70 77 61 69 74 69 6e 67 20 23 . (keepwaiting #
5a50: 74 29 0a 09 20 28 70 69 6e 67 20 20 20 20 28 6d t).. (ping (m
5a60: 61 6b 65 2d 74 68 72 65 61 64 0a 09 09 20 20 20 ake-thread...
5a70: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 20 20 (lambda ()...
5a80: 20 20 28 70 72 69 6e 74 20 22 70 69 6e 67 3a 20 (print "ping:
5a90: 73 65 6e 64 69 6e 67 20 73 74 72 69 6e 67 20 5c sending string \
5aa0: 22 22 20 6b 65 79 20 22 5c 22 2c 20 65 78 70 65 "" key "\", expe
5ab0: 63 74 69 6e 67 20 22 20 28 63 75 72 72 65 6e 74 cting " (current
5ac0: 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 0a 09 09 -process-id))...
5ad0: 20 20 20 20 20 28 6e 6e 2d 73 65 6e 64 20 72 65 (nn-send re
5ae0: 71 20 6b 65 79 29 0a 09 09 20 20 20 20 20 28 6c q key)... (l
5af0: 65 74 20 28 28 72 65 73 75 6c 74 20 20 28 6e 6e et ((result (nn
5b00: 2d 72 65 63 76 20 72 65 71 29 29 29 0a 09 09 20 -recv req)))...
5b10: 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c (if (equal
5b20: 3f 20 28 63 6f 6e 63 20 28 63 75 72 72 65 6e 74 ? (conc (current
5b30: 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 20 72 65 -process-id)) re
5b40: 73 75 6c 74 29 0a 09 09 09 20 20 20 28 62 65 67 sult).... (beg
5b50: 69 6e 0a 09 09 09 20 20 20 20 20 28 70 72 69 6e in.... (prin
5b60: 74 20 22 70 69 6e 67 2c 20 73 75 63 63 65 73 73 t "ping, success
5b70: 3a 20 72 65 63 65 69 76 65 64 20 5c 22 22 20 72 : received \"" r
5b80: 65 73 75 6c 74 20 22 5c 22 22 29 0a 09 09 09 20 esult "\"")....
5b90: 20 20 20 20 28 73 65 74 21 20 73 75 63 63 65 73 (set! succes
5ba0: 73 20 23 74 29 29 0a 09 09 09 20 20 20 28 62 65 s #t)).... (be
5bb0: 67 69 6e 0a 09 09 09 20 20 20 20 20 28 70 72 69 gin.... (pri
5bc0: 6e 74 20 22 70 69 6e 67 2c 20 66 61 69 6c 65 64 nt "ping, failed
5bd0: 3a 20 72 65 63 65 69 76 65 64 20 6b 65 79 20 5c : received key \
5be0: 22 22 20 72 65 73 75 6c 74 20 22 5c 22 22 29 0a "" result "\"").
5bf0: 09 09 09 20 20 20 20 20 28 73 65 74 21 20 6b 65 ... (set! ke
5c00: 65 70 77 61 69 74 69 6e 67 20 23 66 29 0a 09 09 epwaiting #f)...
5c10: 09 20 20 20 20 20 28 73 65 74 21 20 73 75 63 63 . (set! succ
5c20: 65 73 73 20 23 66 29 29 29 29 29 0a 09 09 20 20 ess #f)))))...
5c30: 20 22 70 69 6e 67 22 29 29 0a 09 20 28 74 69 6d "ping")).. (tim
5c40: 65 6f 75 74 20 28 6d 61 6b 65 2d 74 68 72 65 61 eout (make-threa
5c50: 64 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 d (lambda ()....
5c60: 09 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 63 6f . (let loop ((co
5c70: 75 6e 74 20 30 29 29 0a 09 09 09 09 20 20 20 28 unt 0))..... (
5c80: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 29 thread-sleep! 1)
5c90: 0a 09 09 09 09 20 20 20 28 70 72 69 6e 74 20 22 ..... (print "
5ca0: 73 74 69 6c 6c 20 77 61 69 74 69 6e 67 20 61 66 still waiting af
5cb0: 74 65 72 20 22 20 63 6f 75 6e 74 20 22 20 73 65 ter " count " se
5cc0: 63 6f 6e 64 73 2e 2e 2e 22 29 0a 09 09 09 09 20 conds...").....
5cd0: 20 20 28 69 66 20 28 61 6e 64 20 6b 65 65 70 77 (if (and keepw
5ce0: 61 69 74 69 6e 67 20 28 3c 20 63 6f 75 6e 74 20 aiting (< count
5cf0: 31 30 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 10)).....
5d00: 28 6c 6f 6f 70 20 28 2b 20 63 6f 75 6e 74 20 31 (loop (+ count 1
5d10: 29 29 29 29 0a 09 09 09 09 20 28 69 66 20 6b 65 ))))..... (if ke
5d20: 65 70 77 61 69 74 69 6e 67 0a 09 09 09 09 20 20 epwaiting.....
5d30: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 (begin.....
5d40: 20 20 20 20 20 28 70 72 69 6e 74 20 22 74 69 6d (print "tim
5d50: 65 6f 75 74 20 77 61 69 74 69 6e 67 20 66 6f 72 eout waiting for
5d60: 20 70 69 6e 67 22 29 0a 09 09 09 09 20 20 20 20 ping").....
5d70: 20 20 20 28 74 68 72 65 61 64 2d 74 65 72 6d 69 (thread-termi
5d80: 6e 61 74 65 21 20 70 69 6e 67 29 29 29 29 0a 09 nate! ping))))..
5d90: 09 09 20 20 20 20 20 20 20 22 74 69 6d 65 6f 75 .. "timeou
5da0: 74 22 29 29 29 0a 20 20 20 20 28 6e 6e 2d 63 6f t"))). (nn-co
5db0: 6e 6e 65 63 74 20 72 65 71 20 28 63 6f 6e 63 20 nnect req (conc
5dc0: 22 74 63 70 3a 2f 2f 22 20 68 6f 73 74 20 22 3a "tcp://" host ":
5dd0: 22 20 70 6f 72 74 29 29 0a 20 20 20 20 28 68 61 " port)). (ha
5de0: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
5df0: 20 20 20 20 20 65 78 6e 0a 20 20 20 20 20 28 62 exn. (b
5e00: 65 67 69 6e 0a 20 20 20 20 20 20 20 28 70 72 69 egin. (pri
5e10: 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 29 0a 20 nt-call-chain).
5e20: 20 20 20 20 20 20 28 70 72 69 6e 74 20 30 20 22 (print 0 "
5e30: 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f message: " ((co
5e40: 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 ndition-property
5e50: 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 -accessor 'exn '
5e60: 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 20 message) exn)).
5e70: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 65 78 (print "ex
5e80: 6e 3d 22 20 28 63 6f 6e 64 69 74 69 6f 6e 2d 3e n=" (condition->
5e90: 6c 69 73 74 20 65 78 6e 29 29 0a 20 20 20 20 20 list exn)).
5ea0: 20 20 28 70 72 69 6e 74 20 22 70 69 6e 67 20 66 (print "ping f
5eb0: 61 69 6c 65 64 20 74 6f 20 63 6f 6e 6e 65 63 74 ailed to connect
5ec0: 20 74 6f 20 22 20 68 6f 73 74 20 22 3a 22 20 70 to " host ":" p
5ed0: 6f 72 74 29 29 0a 20 20 20 20 20 28 74 68 72 65 ort)). (thre
5ee0: 61 64 2d 73 74 61 72 74 21 20 74 69 6d 65 6f 75 ad-start! timeou
5ef0: 74 29 0a 20 20 20 20 20 28 74 68 72 65 61 64 2d t). (thread-
5f00: 73 74 61 72 74 21 20 70 69 6e 67 29 0a 20 20 20 start! ping).
5f10: 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 (thread-join!
5f20: 70 69 6e 67 29 0a 20 20 20 20 20 28 69 66 20 73 ping). (if s
5f30: 75 63 63 65 73 73 20 28 74 68 72 65 61 64 2d 74 uccess (thread-t
5f40: 65 72 6d 69 6e 61 74 65 21 20 74 69 6d 65 6f 75 erminate! timeou
5f50: 74 29 29 29 0a 20 20 20 20 28 69 66 20 72 65 74 t))). (if ret
5f60: 75 72 6e 2d 73 6f 63 6b 65 74 0a 09 28 69 66 20 urn-socket..(if
5f70: 73 75 63 63 65 73 73 20 72 65 71 20 23 66 29 0a success req #f).
5f80: 09 28 62 65 67 69 6e 0a 09 20 20 28 6e 6e 2d 63 .(begin.. (nn-c
5f90: 6c 6f 73 65 20 72 65 71 29 0a 09 20 20 73 75 63 lose req).. suc
5fa0: 63 65 73 73 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d cess))))..;;====
5fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ff0: 3d 3d 0a 3b 3b 20 43 20 4f 20 4e 20 46 20 49 20 ==.;; C O N F I
6000: 47 20 55 20 52 20 41 20 54 20 49 20 4f 20 4e 20 G U R A T I O N
6010: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
6020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 47 65 =========..;; Ge
6060: 74 20 74 68 65 20 63 6f 6e 66 69 67 75 72 61 74 t the configurat
6070: 69 6f 6e 20 66 69 6c 65 20 66 6f 72 20 61 20 67 ion file for a g
6080: 72 6f 75 70 20 6e 61 6d 65 2c 20 69 66 20 74 68 roup name, if th
6090: 65 20 67 72 6f 75 70 20 6e 61 6d 65 20 69 73 20 e group name is
60a0: 22 64 65 66 61 75 6c 74 22 20 61 6e 64 20 69 74 "default" and it
60b0: 20 64 6f 65 73 6e 27 74 20 0a 3b 3b 20 65 78 69 doesn't .;; exi
60c0: 73 74 2c 20 63 72 65 61 74 65 20 69 74 20 61 6e st, create it an
60d0: 64 20 61 64 64 20 74 68 65 20 63 75 72 72 65 6e d add the curren
60e0: 74 20 70 61 74 68 20 69 66 20 69 74 20 63 6f 6e t path if it con
60f0: 74 61 69 6e 73 20 6d 65 67 61 74 65 73 74 2e 63 tains megatest.c
6100: 6f 6e 66 69 67 0a 3b 3b 0a 28 64 65 66 69 6e 65 onfig.;;.(define
6110: 20 28 64 62 6f 61 72 64 3a 67 65 74 2d 63 6f 6e (dboard:get-con
6120: 66 69 67 20 67 72 6f 75 70 2d 6e 61 6d 65 29 0a fig group-name).
6130: 20 20 28 6c 65 74 2a 20 28 28 66 6e 61 6d 65 20 (let* ((fname
6140: 28 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 22 48 (conc (getenv "H
6150: 4f 4d 45 22 29 20 22 2f 2e 6d 65 67 61 74 65 73 OME") "/.megates
6160: 74 2f 22 20 67 72 6f 75 70 2d 6e 61 6d 65 20 22 t/" group-name "
6170: 2e 64 61 74 22 29 29 29 0a 20 20 20 20 28 69 66 .dat"))). (if
6180: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 (file-exists? f
6190: 6e 61 6d 65 29 0a 09 28 72 65 61 64 2d 63 6f 6e name)..(read-con
61a0: 66 69 67 20 66 6e 61 6d 65 20 28 6d 61 6b 65 2d fig fname (make-
61b0: 68 61 73 68 2d 74 61 62 6c 65 29 20 23 74 29 0a hash-table) #t).
61c0: 09 28 69 66 20 28 64 62 6f 61 72 64 3a 63 72 65 .(if (dboard:cre
61d0: 61 74 65 2d 63 6f 6e 66 69 67 20 66 6e 61 6d 65 ate-config fname
61e0: 29 0a 09 20 20 20 20 28 64 62 6f 61 72 64 3a 67 ).. (dboard:g
61f0: 65 74 2d 63 6f 6e 66 69 67 20 67 72 6f 75 70 2d et-config group-
6200: 6e 61 6d 65 29 0a 09 20 20 20 20 28 6d 61 6b 65 name).. (make
6210: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 29 29 -hash-table)))))
6220: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 6f 61 72 ..(define (dboar
6230: 64 3a 63 72 65 61 74 65 2d 63 6f 6e 66 69 67 20 d:create-config
6240: 66 6e 61 6d 65 29 0a 20 20 3b 3b 20 28 68 61 6e fname). ;; (han
6250: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 dle-exceptions.
6260: 20 3b 3b 20 20 65 78 6e 0a 20 20 3b 3b 20 20 0a ;; exn. ;; .
6270: 20 20 3b 3b 20 20 23 66 20 3b 3b 20 66 61 69 6c ;; #f ;; fail
6280: 65 64 20 74 6f 20 63 72 65 61 74 65 20 2d 20 6a ed to create - j
6290: 75 73 74 20 67 69 76 65 20 75 70 0a 20 20 20 28 ust give up. (
62a0: 6c 65 74 2a 20 28 28 64 69 72 6e 61 6d 65 20 20 let* ((dirname
62b0: 20 20 20 20 20 28 70 61 74 68 6e 61 6d 65 2d 64 (pathname-d
62c0: 69 72 65 63 74 6f 72 79 20 66 6e 61 6d 65 29 29 irectory fname))
62d0: 0a 09 20 20 28 66 69 6c 65 2d 6e 61 6d 65 20 20 .. (file-name
62e0: 20 20 20 28 70 61 74 68 6e 61 6d 65 2d 73 74 72 (pathname-str
62f0: 69 70 2d 64 69 72 65 63 74 6f 72 79 20 66 6e 61 ip-directory fna
6300: 6d 65 29 29 0a 09 20 20 28 63 75 72 72 2d 6d 74 me)).. (curr-mt
6310: 63 66 67 64 61 74 20 28 66 69 6e 64 2d 63 6f 6e cfgdat (find-con
6320: 66 69 67 20 22 6d 65 67 61 74 65 73 74 2e 63 6f fig "megatest.co
6330: 6e 66 69 67 22 0a 09 09 09 09 20 20 20 20 20 20 nfig".....
6340: 74 6f 70 70 61 74 68 3a 20 28 6f 72 20 28 67 65 toppath: (or (ge
6350: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
6360: 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 riable "MT_RUN_A
6370: 52 45 41 5f 48 4f 4d 45 22 29 28 63 75 72 72 65 REA_HOME")(curre
6380: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 29 29 nt-directory))))
6390: 0a 09 20 20 28 63 75 72 72 2d 6d 74 63 66 67 20 .. (curr-mtcfg
63a0: 20 20 20 28 69 66 20 28 61 6e 64 20 63 75 72 72 (if (and curr
63b0: 2d 6d 74 63 66 67 64 61 74 20 28 6e 6f 74 20 28 -mtcfgdat (not (
63c0: 6e 75 6c 6c 3f 20 63 75 72 72 2d 6d 74 63 66 67 null? curr-mtcfg
63d0: 64 61 74 29 29 29 28 63 61 64 72 20 63 75 72 72 dat)))(cadr curr
63e0: 2d 6d 74 63 66 67 64 61 74 29 20 23 66 29 29 0a -mtcfgdat) #f)).
63f0: 09 20 20 28 63 75 72 72 2d 6d 74 70 61 74 68 20 . (curr-mtpath
6400: 20 20 28 69 66 20 63 75 72 72 2d 6d 74 63 66 67 (if curr-mtcfg
6410: 20 28 63 61 72 20 63 75 72 72 2d 6d 74 63 66 67 (car curr-mtcfg
6420: 64 61 74 29 20 23 66 29 29 29 0a 20 20 20 20 20 dat) #f))).
6430: 28 69 66 20 63 75 72 72 2d 6d 74 70 61 74 68 0a (if curr-mtpath.
6440: 09 20 28 62 65 67 69 6e 0a 09 20 20 20 28 64 65 . (begin.. (de
6450: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
6460: 20 22 43 72 65 61 74 69 6e 67 20 63 6f 6e 66 69 "Creating confi
6470: 67 20 66 69 6c 65 20 22 20 66 6e 61 6d 65 29 0a g file " fname).
6480: 09 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 . (if (not (fi
6490: 6c 65 2d 65 78 69 73 74 73 3f 20 64 69 72 6e 61 le-exists? dirna
64a0: 6d 65 29 29 0a 09 20 20 20 20 20 20 20 28 63 72 me)).. (cr
64b0: 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 64 eate-directory d
64c0: 69 72 6e 61 6d 65 20 23 74 29 29 0a 09 20 20 20 irname #t))..
64d0: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
64e0: 66 69 6c 65 20 66 6e 61 6d 65 0a 09 20 20 20 20 file fname..
64f0: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 20 (lambda ()..
6500: 20 20 20 20 28 6c 65 74 20 28 28 61 6e 61 6d 65 (let ((aname
6510: 20 28 70 61 74 68 6e 61 6d 65 2d 73 74 72 69 70 (pathname-strip
6520: 2d 64 69 72 65 63 74 6f 72 79 20 63 75 72 72 2d -directory curr-
6530: 6d 74 70 61 74 68 29 29 29 0a 09 09 20 28 70 72 mtpath)))... (pr
6540: 69 6e 74 20 22 5b 22 20 61 6e 61 6d 65 20 22 5d int "[" aname "]
6550: 22 29 0a 09 09 20 28 70 72 69 6e 74 20 20 22 70 ")... (print "p
6560: 61 74 68 20 22 20 63 75 72 72 2d 6d 74 70 61 74 ath " curr-mtpat
6570: 68 29 29 29 29 0a 09 20 20 20 23 74 29 0a 09 20 h)))).. #t)..
6580: 28 62 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75 (begin.. (debu
6590: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 g:print-info 0 "
65a0: 4e 65 65 64 20 74 6f 20 63 72 65 61 74 65 20 61 Need to create a
65b0: 20 63 6f 6e 66 69 67 20 62 75 74 20 6e 6f 20 6d config but no m
65c0: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 66 egatest.config f
65d0: 6f 75 6e 64 3a 20 22 20 63 75 72 72 2d 6d 74 63 ound: " curr-mtc
65e0: 66 67 64 61 74 29 0a 09 20 20 20 23 66 29 29 29 fgdat).. #f)))
65f0: 29 0a 3b 3b 20 29 0a 0a 28 64 65 66 69 6e 65 20 ).;; )..(define
6600: 28 64 62 6f 61 72 64 3a 72 65 61 64 2d 6d 74 63 (dboard:read-mtc
6610: 6f 6e 66 20 61 70 61 74 68 29 0a 20 20 28 6c 65 onf apath). (le
6620: 74 2a 20 28 28 6d 74 63 6f 6e 66 66 69 6c 65 20 t* ((mtconffile
6630: 20 28 63 6f 6e 63 20 61 70 61 74 68 20 22 2f 6d (conc apath "/m
6640: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 egatest.config")
6650: 29 29 0a 20 20 20 20 28 63 61 6c 6c 2d 77 69 74 )). (call-wit
6660: 68 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 h-environment-va
6670: 72 69 61 62 6c 65 73 0a 20 20 20 20 20 28 6c 69 riables. (li
6680: 73 74 20 28 63 6f 6e 73 20 22 4d 54 5f 52 55 4e st (cons "MT_RUN
6690: 5f 41 52 45 41 5f 48 4f 4d 45 22 20 61 70 61 74 _AREA_HOME" apat
66a0: 68 29 29 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 h)). (lambda
66b0: 20 28 29 0a 20 20 20 20 20 20 20 28 72 65 61 64 (). (read
66c0: 2d 63 6f 6e 66 69 67 20 6d 74 63 6f 6e 66 66 69 -config mtconffi
66d0: 6c 65 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 le (make-hash-ta
66e0: 62 6c 65 29 20 23 66 29 29 20 3b 3b 20 6d 65 67 ble) #f)) ;; meg
66f0: 61 74 65 73 74 2e 63 6f 6e 66 69 67 0a 20 20 20 atest.config.
6700: 20 20 29 29 29 0a 09 20 0a 0a 3b 3b 3d 3d 3d 3d ))).. ..;;====
6710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6750: 3d 3d 0a 3b 3b 20 47 20 55 20 49 20 20 20 53 20 ==.;; G U I S
6760: 54 20 55 20 46 20 46 20 0a 3b 3b 3d 3d 3d 3d 3d T U F F .;;=====
6770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67b0: 3d 0a 0a 3b 3b 3b 20 6d 61 69 6e 2e 20 54 68 65 =..;;; main. The
67c0: 6f 72 65 74 69 63 61 6c 6c 79 20 63 6f 75 6c 64 oretically could
67d0: 20 68 61 76 65 20 6d 75 6c 74 69 70 6c 65 20 77 have multiple w
67e0: 69 6e 64 6f 77 73 20 28 65 61 63 68 20 77 69 74 indows (each wit
67f0: 68 20 61 20 67 72 6f 75 70 20 6f 66 20 74 61 67 h a group of tag
6800: 73 2c 20 74 68 75 73 20 77 69 6e 64 6f 77 2d 69 s, thus window-i
6810: 64 0a 3b 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 d.;;;.(define (d
6820: 62 6f 61 72 64 3a 6d 61 6b 65 2d 77 69 6e 64 6f board:make-windo
6830: 77 20 77 69 6e 64 6f 77 2d 69 64 29 0a 20 20 28 w window-id). (
6840: 6c 65 74 2a 20 28 3b 3b 20 28 77 69 6e 64 6f 77 let* (;; (window
6850: 2d 69 64 20 30 29 0a 09 20 28 67 72 6f 75 70 6e -id 0).. (groupn
6860: 20 20 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 (or (args:ge
6870: 74 2d 61 72 67 20 22 2d 67 72 6f 75 70 22 29 20 t-arg "-group")
6880: 22 64 65 66 61 75 6c 74 22 29 29 0a 09 20 28 63 "default")).. (c
6890: 66 67 64 61 74 20 20 20 20 28 64 62 6f 61 72 64 fgdat (dboard
68a0: 3a 67 65 74 2d 63 6f 6e 66 69 67 20 67 72 6f 75 :get-config grou
68b0: 70 6e 29 29 0a 09 20 3b 3b 20 28 63 66 67 64 61 pn)).. ;; (cfgda
68c0: 74 20 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 t (if (file-e
68d0: 78 69 73 74 73 3f 20 63 66 6e 61 6d 65 29 28 72 xists? cfname)(r
68e0: 65 61 64 2d 63 6f 6e 66 69 67 20 63 66 6e 61 6d ead-config cfnam
68f0: 65 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 e (make-hash-tab
6900: 6c 65 29 20 23 74 29 28 6d 61 6b 65 2d 68 61 73 le) #t)(make-has
6910: 68 2d 74 61 62 6c 65 29 29 29 0a 09 20 28 64 61 h-table))).. (da
6920: 74 61 20 20 20 20 20 20 28 6d 61 6b 65 2d 64 61 ta (make-da
6930: 74 61 0a 09 09 20 20 20 20 20 63 66 67 64 61 74 ta... cfgdat
6940: 20 3b 3b 20 74 68 69 73 20 69 73 20 74 68 65 20 ;; this is the
6950: 64 61 74 61 20 66 72 6f 6d 20 7e 2f 2e 6d 65 67 data from ~/.meg
6960: 61 74 65 73 74 20 66 6f 72 20 74 68 65 20 73 65 atest for the se
6970: 6c 65 63 74 65 64 20 67 72 6f 75 70 0a 09 09 20 lected group...
6980: 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 (make-hash-t
6990: 61 62 6c 65 29 20 3b 3b 20 61 72 65 61 6e 61 6d able) ;; areanam
69a0: 65 20 2d 3e 20 61 72 65 61 2d 72 65 63 0a 09 09 e -> area-rec...
69b0: 20 20 20 20 20 30 20 20 20 20 20 20 20 20 20 20 0
69c0: 20 20 20 20 20 20 20 3b 3b 20 63 75 72 72 65 6e ;; curren
69d0: 74 20 77 69 6e 64 6f 77 20 69 64 0a 09 09 20 20 t window id...
69e0: 20 20 20 30 20 20 20 20 20 20 20 20 20 20 20 20 0
69f0: 20 20 20 20 20 3b 3b 20 63 75 72 72 65 6e 74 20 ;; current
6a00: 74 61 62 20 69 64 0a 09 09 20 20 20 20 20 23 66 tab id... #f
6a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6a20: 3b 3b 20 72 65 64 72 61 77 20 6e 65 65 64 65 64 ;; redraw needed
6a30: 20 66 6f 72 20 63 75 72 72 65 6e 74 20 74 61 62 for current tab
6a40: 20 69 64 0a 09 09 20 20 20 20 20 28 6d 61 6b 65 id... (make
6a50: 2d 68 61 73 68 2d 74 61 62 6c 65 29 20 3b 3b 20 -hash-table) ;;
6a60: 74 61 62 2d 69 64 20 2d 3e 20 61 72 65 61 6e 61 tab-id -> areana
6a70: 6d 65 0a 09 09 20 20 20 20 20 29 29 29 0a 20 20 me... ))).
6a80: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
6a90: 74 21 20 2a 77 69 6e 64 6f 77 73 2a 20 77 69 6e t! *windows* win
6aa0: 64 6f 77 2d 69 64 20 64 61 74 61 29 0a 20 20 20 dow-id data).
6ab0: 20 28 69 75 70 3a 73 68 6f 77 20 28 64 61 73 68 (iup:show (dash
6ac0: 62 6f 61 72 64 3a 6d 61 69 6e 2d 70 61 6e 65 6c board:main-panel
6ad0: 20 64 61 74 61 20 77 69 6e 64 6f 77 2d 69 64 29 data window-id)
6ae0: 29 0a 20 20 20 20 28 69 75 70 3a 6d 61 69 6e 2d ). (iup:main-
6af0: 6c 6f 6f 70 29 29 29 0a 0a 3b 3b 20 65 61 73 65 loop)))..;; ease
6b00: 20 64 65 62 75 67 67 69 6e 67 20 62 79 20 6c 6f debugging by lo
6b10: 61 64 69 6e 67 20 7e 2f 2e 64 61 73 68 62 6f 61 ading ~/.dashboa
6b20: 72 64 72 63 0a 28 6c 65 74 20 28 28 64 65 62 75 rdrc.(let ((debu
6b30: 67 63 6f 6e 74 72 6f 6c 66 20 28 63 6f 6e 63 20 gcontrolf (conc
6b40: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
6b50: 2d 76 61 72 69 61 62 6c 65 20 22 48 4f 4d 45 22 -variable "HOME"
6b60: 29 20 22 2f 2e 64 61 73 68 62 6f 61 72 64 72 63 ) "/.dashboardrc
6b70: 22 29 29 29 0a 20 20 28 69 66 20 28 66 69 6c 65 "))). (if (file
6b80: 2d 65 78 69 73 74 73 3f 20 64 65 62 75 67 63 6f -exists? debugco
6b90: 6e 74 72 6f 6c 66 29 0a 20 20 20 20 20 20 28 6c ntrolf). (l
6ba0: 6f 61 64 20 64 65 62 75 67 63 6f 6e 74 72 6f 6c oad debugcontrol
6bb0: 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d f)))..(define (m
6bc0: 61 69 6e 29 0a 20 20 28 6c 65 74 2d 76 61 6c 75 ain). (let-valu
6bd0: 65 73 20 0a 20 20 20 20 20 20 28 28 28 63 6f 6e es . (((con
6be0: 20 70 6f 72 74 29 28 64 62 6f 61 72 64 3a 73 65 port)(dboard:se
6bf0: 72 76 65 72 2d 73 74 61 72 74 20 23 66 29 29 29 rver-start #f)))
6c00: 0a 20 20 20 20 28 6c 65 74 20 28 28 70 6f 72 74 . (let ((port
6c10: 6e 75 6d 20 20 20 28 69 66 20 28 73 74 72 69 6e num (if (strin
6c20: 67 3f 20 70 6f 72 74 29 28 73 74 72 69 6e 67 2d g? port)(string-
6c30: 3e 6e 75 6d 62 65 72 20 70 6f 72 74 29 20 70 6f >number port) po
6c40: 72 74 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 67 rt))). ;; g
6c50: 6f 74 20 68 65 72 65 2c 20 6d 6f 6e 69 74 6f 72 ot here, monitor
6c60: 2f 64 61 73 68 62 6f 61 72 64 20 77 61 73 20 73 /dashboard was s
6c70: 74 61 72 74 65 64 0a 20 20 20 20 20 20 28 6d 64 tarted. (md
6c80: 64 62 3a 72 65 67 69 73 74 65 72 2d 64 61 73 68 db:register-dash
6c90: 62 6f 61 72 64 20 70 6f 72 74 6e 75 6d 29 0a 20 board portnum).
6ca0: 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 (thread-sta
6cb0: 72 74 21 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 rt! (make-thread
6cc0: 20 28 6c 61 6d 62 64 61 20 28 29 28 64 62 6f 61 (lambda ()(dboa
6cd0: 72 64 3a 73 65 72 76 65 72 2d 73 65 72 76 69 63 rd:server-servic
6ce0: 65 20 63 6f 6e 20 70 6f 72 74 6e 75 6d 29 29 20 e con portnum))
6cf0: 22 73 65 72 76 65 72 20 73 65 72 76 69 63 65 22 "server service"
6d00: 29 29 0a 20 20 20 20 20 20 28 74 68 72 65 61 64 )). (thread
6d10: 2d 73 74 61 72 74 21 20 28 6d 61 6b 65 2d 74 68 -start! (make-th
6d20: 72 65 61 64 20 28 6c 61 6d 62 64 61 20 28 29 0a read (lambda ().
6d30: 09 09 09 09 20 20 20 20 28 6c 65 74 20 6c 6f 6f .... (let loo
6d40: 70 20 28 29 0a 09 09 09 09 20 20 20 20 20 20 28 p ()..... (
6d50: 64 62 6f 61 72 64 3a 67 65 6e 65 72 61 6c 2d 75 dboard:general-u
6d60: 70 64 61 74 65 72 20 63 6f 6e 20 70 6f 72 74 6e pdater con portn
6d70: 75 6d 29 0a 09 09 09 09 20 20 20 20 20 20 28 74 um)..... (t
6d80: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 29 0a hread-sleep! 1).
6d90: 09 09 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 29 .... (loop)
6da0: 29 29 20 22 67 65 6e 65 72 61 6c 20 75 70 64 61 )) "general upda
6db0: 74 65 72 22 29 29 0a 20 20 20 20 20 20 28 64 62 ter")). (db
6dc0: 6f 61 72 64 3a 6d 61 6b 65 2d 77 69 6e 64 6f 77 oard:make-window
6dd0: 20 30 29 0a 20 20 20 20 20 20 28 6d 64 64 62 3a 0). (mddb:
6de0: 75 6e 72 65 67 69 73 74 65 72 2d 64 61 73 68 62 unregister-dashb
6df0: 6f 61 72 64 20 28 67 65 74 2d 68 6f 73 74 2d 6e oard (get-host-n
6e00: 61 6d 65 29 20 70 6f 72 74 6e 75 6d 29 0a 20 20 ame) portnum).
6e10: 20 20 20 20 28 64 62 6f 61 72 64 3a 73 65 72 76 (dboard:serv
6e20: 65 72 2d 63 6c 6f 73 65 20 63 6f 6e 20 70 6f 72 er-close con por
6e30: 74 29 29 29 29 0a 0a t))))..