︙ | | |
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
-
+
|
(target #f)
(test-patts #f)
;; db info to file the .db files for the area
(dbdir #f)
(dbfpath #f)
(dbkeys #f)
((last-db-update 0) : number) ;; last db file timestamp
((last-db-update (make-hash-table)) : hash-table) ;; last db file timestamp
(monitor-db-path #f) ;; where to find monitor.db
ro ;; is the database read-only?
;; tests data
((num-tests 10) : number) ;; total number of tests to show (used in the old runs display)
;; runs tree
|
︙ | | |
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
|
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
|
+
+
-
-
+
|
(dboard:tabdat-filters-changed-set! tabdat #t)))
(define (update-search commondat tabdat x val)
(hash-table-set! (dboard:tabdat-searchpatts tabdat) x val)
(dboard:tabdat-filters-changed-set! tabdat #t)
(set-bg-on-filter commondat tabdat))
;; force ALL updates to zero (effectively)
;;
(define (mark-for-update tabdat)
;; (dboard:tabdat-filters-changed-set! tabdat #t)
(dboard:tabdat-last-db-update-set! tabdat 0))
(dboard:tabdat-last-db-update-set! tabdat (make-hash-table)))
;;======================================================================
;; R U N C O N T R O L
;;======================================================================
;; target populating logic
;;
|
︙ | | |
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
|
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
|
-
+
-
+
|
(for-each (lambda (run)
(hash-table-set! ht (db:get-value-by-header run runs-header "id") run))
runs) ht)))
runs-hash))
(define (dashboard:runs-summary-updater commondat tabdat tb cell-lookup run-matrix)
(if (dashboard:database-changed? commondat tabdat)
(if (dashboard:database-changed? commondat tabdat context-key: 'runs-summary-rundat)
(dashboard:do-update-rundat tabdat))
(dboard:runs-summary-control-panel-updater tabdat)
(let* ((last-runs-update (dboard:tabdat-last-runs-update tabdat))
(runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))
(runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
(runs (vector-ref runs-dat 1))
(run-id (dboard:tabdat-curr-run-id tabdat))
(runs-hash (dashboard:get-runs-hash tabdat))
;; (runs-hash (let ((ht (make-hash-table)))
;; (for-each (lambda (run)
;; (hash-table-set! ht (db:get-value-by-header run runs-header "id") run))
;; runs)
;; ht))
)
(if (dashboard:database-changed? commondat tabdat)
(if (dashboard:database-changed? commondat tabdat context-key: 'runs-summary-tree)
(dboard:update-tree tabdat runs-hash runs-header tb))
(if run-id
(let* ((matrix-content
(case (dboard:tabdat-runs-summary-mode tabdat)
((one-run) (dashboard:run-id->tests-mindat run-id tabdat runs-hash))
((xor-two-runs) (dashboard:runs-summary-xor-matrix-content tabdat runs-hash))
((xor-two-runs-hide-clean) (dashboard:runs-summary-xor-matrix-content tabdat runs-hash hide-clean: #t))
|
︙ | | |
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
|
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
|
-
+
|
)
)
)) "runs-summary-click-callback"))))
(runs-summary-updater
(lambda ()
(mutex-lock! update-mutex)
(if (or (dashboard:database-changed? commondat tabdat)
(if (or (dashboard:database-changed? commondat tabdat context-key: 'runs-summary-updater)
(dboard:tabdat-view-changed tabdat))
(debug:catch-and-dump
(lambda () ;; check that run-matrix is initialized before calling the updater
(if run-matrix
(dashboard:runs-summary-updater commondat tabdat tb cell-lookup run-matrix)))
"dashboard:runs-summary-updater")
)
|
︙ | | |
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
|
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
|
+
+
+
+
+
+
-
+
+
-
-
+
+
+
|
(or (> monitor-modtime *last-monitor-update-time*)
(> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case
(begin
(set! *last-monitor-update-time* run-update-time) ;; monitor-modtime)
#t)
#f)))
(define (dboard:get-last-db-update tabdat context)
(hash-table-ref/default (dboard:tabdat-last-db-update tabdat) context 0))
(define (dboard:set-last-db-update! tabdat context newtime)
(hash-table-set! (dboard:tabdat-last-db-update tabdat) context newtime))
(define (dashboard:database-changed? commondat tabdat)
(define (dashboard:database-changed? commondat tabdat #!key (context-key 'default))
(let* ((run-update-time (current-seconds))
(modtime (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!!
(recalc (dashboard:recalc modtime
(dboard:commondat-please-update commondat)
(dboard:get-last-db-update tabdat context-key))))
(dboard:tabdat-last-db-update tabdat))))
(if recalc (dboard:tabdat-last-db-update-set! tabdat run-update-time))
;; (dboard:tabdat-last-db-update tabdat))))
(if recalc
(dboard:set-last-db-update! tabdat context-key run-update-time))
(dboard:commondat-please-update-set! commondat #f)
recalc))
;; point inside line
;;
(define-inline (dashboard:px-between px lx1 lx2)
(and (< lx1 px)(> lx2 px)))
|
︙ | | |
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
|
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
|
+
-
+
+
|
(list k v))
(dboard:tabdat-keys tabdat)
(take (append (or (dboard:tabdat-target tabdat);; (string-split (dboard: "/")
'("%" "%"))
(make-list num-keys "%"))
num-keys)
))
(runpatt (if (and (dboard:tabdat-target tabdat)
(runpatt (if (dboard:tabdat-target tabdat)
(list? (dboard:tabdat-target tabdat))
(not (null? (dboard:tabdat-target tabdat))))
(last (dboard:tabdat-target tabdat))
"%"))
(testpatt (or (dboard:tabdat-test-patts tabdat) "%"))
(filtrstr (conc targpatt "/" runpatt "/" testpatt)))
;; (print "targpatt: " targpatt " runpatt: " runpatt " testpatt: " testpatt)
(if (not (equal? (dboard:tabdat-last-filter-str tabdat) filtrstr))
|
︙ | | |
︙ | | |
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
|
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
|
-
+
|
general-matrix))
(define (dcommon:run-stats commondat tabdat #!key (tab-num #f))
(let* ((stats-matrix (iup:matrix expand: "YES"))
(changed #f)
(stats-updater (lambda ()
(if (dashboard:database-changed? commondat tabdat)
(if (dashboard:database-changed? commondat tabdat context-key: 'run-stats)
(let* ((run-stats (rmt:get-run-stats))
(indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell))
(row-indices (car indices))
(col-indices (cadr indices))
(max-row (if (null? row-indices) 1 (apply max (map cadr row-indices))))
(max-col (if (null? col-indices) 1
(apply max (map cadr col-indices))))
|
︙ | | |
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
|
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
|
-
+
-
+
|
(if (not (equal? val ""))
(begin
(iup:attribute-set! tb "VALUE" val)
(dboard:tabdat-run-name-set! tabdat val)
(dashboard:update-run-command tabdat))))
"command-runname-selector lb action"))))
(refresh-runs-list (lambda ()
(if (dashboard:database-changed? commondat tabdat)
(if (dashboard:database-changed? commondat tabdat context-key: 'runname-selector-runs-list)
(let* ((target (dboard:tabdat-target-string tabdat))
(runs-for-targ (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" target #f #f #f 0))
(runs-header (vector-ref runs-for-targ 0))
(runs-dat (vector-ref runs-for-targ 1))
(run-names (cons default-run-name
(map (lambda (x)
(db:get-value-by-header x runs-header "runname"))
runs-dat))))
;; (iup:attribute-set! lb "REMOVEITEM" "ALL")
(iuplistbox-fill-list lb run-names selected-item: default-run-name))))))
;; (dboard:tabdat-updater-for-runs-set! tabdat refresh-runs-list)
(dboard:commondat-add-updater commondat refresh-runs-list tab-num: tab-num)
(refresh-runs-list)
;; (refresh-runs-list)
(dboard:tabdat-run-name-set! tabdat default-run-name)
(iup:hbox
tb
lb))))
(define (dcommon:command-testname-selector commondat tabdat update-keyvals) ;; key-listboxes)
(iup:vbox
|
︙ | | |