420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
|
(define (update-search x val)
;; (print "Setting search for " x " to " val)
(hash-table-set! *searchpatts* x val))
(define (mark-for-update)
(set! *last-db-update-time* 0)
(set! *delayed-update* 1)
)
(define (make-dashboard-buttons nruns ntests keynames)
(let* ((nkeys (length keynames))
(runsvec (make-vector nruns))
(header (make-vector nruns))
(lftcol (make-vector ntests))
(keycol (make-vector ntests))
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
|
(define (update-search x val)
;; (print "Setting search for " x " to " val)
(hash-table-set! *searchpatts* x val))
(define (mark-for-update)
(set! *last-db-update-time* 0)
(set! *delayed-update* 1))
;;======================================================================
;; R U N C O N T R O L
;;======================================================================
(define (dashboard:run-controls)
(let* ((targets (make-hash-table))
(runconf-targs (common:get-runconfig-targets))
(db-target-dat (open-run-close db:get-targets #f))
(header (vector-ref db-target-dat 0))
(db-targets (vector-ref db-target-dat 1))
(tests (make-hash-table))
(action "-runtests")
(cmdln "")
(runlogs (make-hash-table)))
;; refer to *keys*, *dbkeys* for keys
(print "db-targets: " db-targets)
(iup:vbox
(iup:hbox
;; Target and action
(iup:vbox
;; Target selectors
(apply iup:hbox
(map
(lambda (key)
(print "Label key=" key)
(iup:label key #:size "x15" #:fontsize "10" #:expand "HORIZONTAL"))
header)))
;; key1 key2 key3 ...
;; target entry (wild cards allowed)
;; The action
(iup:hbox
;; label Action | action selector
))
;; Test/items selector
(iup:hbox
;; tests
;; items
))
;; The command line
(iup:hbox
;; commandline entry
;; GO button
)
;; The command log monitor
(iup:tabs
;; log monitor
)))
;;======================================================================
;; R U N S
;;======================================================================
(define (make-dashboard-buttons nruns ntests keynames)
(let* ((nkeys (length keynames))
(runsvec (make-vector nruns))
(header (make-vector nruns))
(lftcol (make-vector ntests))
(keycol (make-vector ntests))
|
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
|
(hash-table-set! *buttondat* button-key (vector 0 "100 100 100" button-key #f #f))
(vector-set! testvec testnum butn)
(loop runnum (+ testnum 1) testvec (cons butn res))))))
;; now assemble the hdrlst and bdylst and kick off the dialog
(iup:show
(iup:dialog
#:title "Megatest dashboard"
(iup:vbox
(apply iup:hbox
(cons (apply iup:vbox lftlst)
(list
(iup:vbox
;; the header
(apply iup:hbox (reverse hdrlst))
(apply iup:hbox (reverse bdylst))))))
controls)))
(vector keycol lftcol header runsvec)))
(if (or (args:get-arg "-rows")
(get-environment-variable "DASHBOARDROWS" ))
(begin
(set! *num-tests* (string->number (or (args:get-arg "-rows")
(get-environment-variable "DASHBOARDROWS"))))
(update-rundat "%" *num-runs* "%/%" '()))
|
>
|
|
|
|
|
|
|
|
|
>
>
>
>
>
|
|
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
|
(hash-table-set! *buttondat* button-key (vector 0 "100 100 100" button-key #f #f))
(vector-set! testvec testnum butn)
(loop runnum (+ testnum 1) testvec (cons butn res))))))
;; now assemble the hdrlst and bdylst and kick off the dialog
(iup:show
(iup:dialog
#:title "Megatest dashboard"
(let ((tabs (iup:tabs
(iup:vbox
(apply iup:hbox
(cons (apply iup:vbox lftlst)
(list
(iup:vbox
;; the header
(apply iup:hbox (reverse hdrlst))
(apply iup:hbox (reverse bdylst))))))
controls)
(dashboard:run-controls)
)))
(iup:attribute-set! tabs "TABTITLE0" "Runs")
(iup:attribute-set! tabs "TABTITLE1" "Run Control")
tabs)))
(vector keycol lftcol header runsvec)))
(if (or (args:get-arg "-rows")
(get-environment-variable "DASHBOARDROWS" ))
(begin
(set! *num-tests* (string->number (or (args:get-arg "-rows")
(get-environment-variable "DASHBOARDROWS"))))
(update-rundat "%" *num-runs* "%/%" '()))
|