439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
|
steps-matrix
data-matrix)))
(iup:attribute-set! tabs "TABTITLE0" "Test Steps")
(iup:attribute-set! tabs "TABTITLE1" "Test Data")
tabs)))))
;; Test browser
(define (tree-browser data window-id)
;; (iup:split
(let* ((tb (iup:treebox
#:selection-cb
(lambda (obj id state)
;; (print "obj: " obj ", id: " id ", state: " state)
(let* ((tree-path (tree:node->path obj id))
(area (car tree-path))
|
|
|
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
|
steps-matrix
data-matrix)))
(iup:attribute-set! tabs "TABTITLE0" "Test Steps")
(iup:attribute-set! tabs "TABTITLE1" "Test Data")
tabs)))))
;; Test browser
(define (tree-browser data adat window-id)
;; (iup:split
(let* ((tb (iup:treebox
#:selection-cb
(lambda (obj id state)
;; (print "obj: " obj ", id: " id ", state: " state)
(let* ((tree-path (tree:node->path obj id))
(area (car tree-path))
|
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
|
))
(dcommon:populate-steps steps-dat steps-matrix))))))
;;(list meta-dat-matrix
;; (if test-id
;; (list (
;; db:test-get-id
;; db:test-get-run_id
;; db:test-get-testname
;; db:test-get-state
;; db:test-get-status
;; db:test-get-event_time
;; db:test-get-host
;; db:test-get-cpuload
;; db:test-get-diskfree
;; db:test-get-uname
;; db:test-get-rundir
;; db:test-get-item-path
;; db:test-get-run_duration
;; db:test-get-final_logf
;; db:test-get-comment
;; db:test-get-fullname
(define (area-display data window-id)
(let* ((view-matrix (iup:matrix
#:expand "YES"
;; #:fittosize "YES"
#:scrollbar "YES"
#:numcol 100
#:numlin 100
#:numcol-visible 3
#:numlin-visible 3
#:click-cb (lambda (obj lin col status)
(print "obj: " obj " lin: " lin " col: " col " status: " status)))))
(iup:attribute-set! view-matrix "RESIZEMATRIX" "YES")
(iup:attribute-set! view-matrix "WIDTH0" "100")
;; (dboard:data-set-runs-matrix! *data* runs-matrix)
(iup:hbox
(iup:frame
#:title "Runs browser"
(iup:vbox
view-matrix)))))
;; Browse and control a single run
;;
(define (runcontrol window-id)
(iup:hbox))
;;======================================================================
;; D A S H B O A R D
;;======================================================================
(define (make-area-panel data area-name window-id)
(iup:split
#:value 200
(tree-browser data window-id) ;; (dboard:areas-tree-browser data)
(area-display data window-id)))
(let* ((area-names (hash-table-keys (dboard:areas-area-groups data)))
(areas (map (lambda (aname)
(make-area-panel data aname window-id))
area-names))
(tabtop (apply iup:tabs areas)))
(let loop ((index 0)
(hed (car area-names))
(tal (cdr area-names)))
(debug:print 0 "Adding area " hed " with index " index " to dashboard")
(iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
(if (not (null? tal))
(loop (+ index 1)(car tal)(cdr tal))))
tabtop))))
(define *current-window-id* 0)
(define (newdashboard data window-id)
(let* (;; (keys (db:get-keys *dbstruct-local* *area-dat*))
;; (runname "%")
;; (testpatt "%")
;; (keypatts (map (lambda (k)(list k "%")) keys))
;; (states '())
;; (statuses '())
(nextmintime (current-milliseconds)))
(dboard:areas-current-window-id-set! data (+ 1 (dboard:areas-current-window-id data)))
;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
(iup:show (main-panel data (dboard:areas-current-window-id data)))
;; Yes, running iup:show will pop up a new panel
;; (iup:show (main-panel my-window-id))
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (x)
(let ((starttime (current-milliseconds)))
;; Want to dedicate no more than 50% of the time to this so skip if
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
>
>
>
>
>
>
|
|
>
|
<
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
<
<
|
|
|
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
|
))
(dcommon:populate-steps steps-dat steps-matrix))))))
;;(list meta-dat-matrix
;; (if test-id
;; (list (
;;======================================================================
;; R U N C O N T R O L
;;======================================================================
;; General displayer
;;
(define (area-display data adat window-id)
(let* ((view-matrix (iup:matrix
#:expand "YES"
;; #:fittosize "YES"
#:scrollbar "YES"
#:numcol 100
#:numlin 100
#:numcol-visible 3
#:numlin-visible 3
#:click-cb (lambda (obj lin col status)
(print "obj: " obj " lin: " lin " col: " col " status: " status)))))
(iup:attribute-set! view-matrix "RESIZEMATRIX" "YES")
(iup:attribute-set! view-matrix "WIDTH0" "100")
(dboard:area-matrix-set! adat view-matrix)
;; (dboard:data-set-runs-matrix! *data* runs-matrix)
(iup:hbox
(iup:frame
#:title "Runs browser"
(iup:vbox
view-matrix)))))
;; Browse and control a single run
;;
(define (runcontrol window-id)
(iup:hbox))
;;======================================================================
;; D A S H B O A R D
;;======================================================================
(define (make-area-panel data area-name window-id)
(let* ((adat (hash-table-ref areas area-name))
(tb (tree-browser data adat window-id)) ;; (dboard:areas-tree-browser data)
(ad (area-display data adat window-id))
(areas (dboard:data-areas data)))
(dboard:area-tree-set! adat tb)
(dboard:area-matrix-set! adat ad)
(iup:split
#:value 200
tb ad)))
;; Main Panel
(define (main-panel data window-id)
(iup:dialog
#:title "Megatest Control Panel"
#:menu (dcommon:main-menu data)
#:shrink "YES"
(iup:vbox
(let* ((area-names (hash-table-keys (dboard:data-cfgdat data)))
(area-panels (map (lambda (aname)
(make-area-panel data aname window-id))
area-names))
(tabtop (apply iup:tabs areas)))
(let loop ((index 0)
(hed (car area-names))
(tal (cdr area-names)))
(let* ((apath (hash-table-ref (dboard:data-cfgdat data)) hed)
(mtconf (read-config apath (make-hash-table) #f)) ;; megatest.config
(area-dat (make-megatest:area
hed ;; area name
apath ;; path to area
'http ;; transport
(list apath mtconf) ;; configinfo (legacy)
mtconf ;; megatest.config
(make-hash-table)
#f
#f ;; remote connections
#f ;; run keys
(make-hash-table) ;; run-id -> (hash of test-ids => dat)
)))
(hash-table-set! (dboard:data-areas data) hed
(make-dboard:area
#f ;; tree
#f ;; matrix
(and (file-exists? apath)
(file-write-access? apath))
area-dat
hed
))
(debug:print 0 "Adding area " hed " with index " index " to dashboard")
(iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
(if (not (null? tal))
(loop (+ index 1)(car tal)(cdr tal))))
tabtop)))))
(define (newdashboard data window-id)
(let* (;; (keys (db:get-keys *dbstruct-local* *area-dat*))
;; (runname "%")
;; (testpatt "%")
;; (keypatts (map (lambda (k)(list k "%")) keys))
;; (states '())
;; (statuses '())
(nextmintime (current-milliseconds)))
(dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data)))
;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
(iup:show (main-panel data (dboard:data-current-window-id data)))
;; Yes, running iup:show will pop up a new panel
;; (iup:show (main-panel my-window-id))
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (x)
(let ((starttime (current-milliseconds)))
;; Want to dedicate no more than 50% of the time to this so skip if
|
646
647
648
649
650
651
652
653
654
655
656
657
658
659
|
;;; main. Theoretically could have multiple windows (each with a group of tags, thus window-id
;;;
(let* ((window-id 0)
(groupn (or (args:get-arg "-group") "default"))
(cfname (conc (getenv "HOME") "/.megatest/" groupn ".dat"))
(cfgdat (if (file-exists? cfname)(read-config cfname (make-hash-table) #t)))
(data (make-dboard:areas
cfgdat
0
#f)))
;; (dboard:areas-tree-browser-set! data (tree-browser data window-id)) ;; data will have "areaname" => "area record" entries
(newdashboard data window-id)
(iup:main-loop))
|
|
|
>
|
<
|
656
657
658
659
660
661
662
663
664
665
666
667
668
669
|
;;; main. Theoretically could have multiple windows (each with a group of tags, thus window-id
;;;
(let* ((window-id 0)
(groupn (or (args:get-arg "-group") "default"))
(cfname (conc (getenv "HOME") "/.megatest/" groupn ".dat"))
(cfgdat (if (file-exists? cfname)(read-config cfname (make-hash-table) #t)))
(data (make-dboard:data
cfgdat ;; this is the data from ~/.megatest for the selected group
(make-hash-table) ;; areaname -> area-rec
0
)))
(newdashboard data window-id)
(iup:main-loop))
|