| ︙ | | |
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
+
|
please-update
tabdats
update-mutex
updaters
updating
uidat ;; needs to move to tabdat at some time
hide-not-hide-tabs
(area-dat (make-remote))
)
(define (dboard:commondat-make)
(make-dboard:commondat
curr-tab-num: 0
tabdats: (make-hash-table)
please-update: #t
|
| ︙ | | |
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
|
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
|
-
+
-
+
|
(define (dboard:tabdat-make-data)
(let ((dat (make-dboard:tabdat)))
(dboard:setup-tabdat dat)
(dboard:setup-num-rows dat)
dat))
(define (dboard:setup-tabdat tabdat)
(define (dboard:setup-tabdat tabdat area-dat)
(dboard:tabdat-dbdir-set! tabdat (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(dboard:tabdat-dbfpath-set! tabdat (db:dbfile-path))
(dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db"))
;; HACK ALERT: this is a hack, please fix.
(dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat))))
(dboard:tabdat-keys-set! tabdat (db:dispatch-query (db:get-access-mode) rmt:get-keys db:get-keys))
(dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname")))
(dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%"))
(dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs area-dat "%"))
)
;; RADT => Matrix defstruct addition
(defstruct dboard:graph-dat
((id #f) : string)
((color #f) : vector)
((flag #t) : boolean)
|
| ︙ | | |
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
|
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
|
-
+
-
+
+
+
-
-
-
-
-
+
+
+
+
+
|
;; newdat)))
;; this calls dboard:get-tests-for-run-duplicate for each run
;;
;; create a virtual table of all the tests
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
;;
(define (update-rundat tabdat runnamepatt numruns testnamepatt keypatts)
(define (update-rundat tabdat area-dat runnamepatt numruns testnamepatt keypatts)
(let* ((access-mode (dboard:tabdat-access-mode tabdat))
(keys (db:dispatch-query access-mode rmt:get-keys db:get-keys))
(keys ;; (db:dispatch-query access-mode rmt:get-keys db:get-keys))
(rmt:get-keys area-dat))
(last-runs-update (- (dboard:tabdat-last-runs-update tabdat) 2))
(allruns (rmt:get-runs area-dat runnamepatt numruns (dboard:tabdat-start-run-offset tabdat) keypatts))
(allruns (db:dispatch-query access-mode rmt:get-runs db:get-runs
runnamepatt numruns (dboard:tabdat-start-run-offset tabdat) keypatts))
;;(allruns-tree (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f))
(allruns-tree (db:dispatch-query access-mode rmt:get-runs-by-patt db:get-runs-by-patt
keys "%" #f #f #f #f last-runs-update));;'("id" "runname")
|
| ︙ | | |
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
|
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
|
-
+
|
(let loop ((run (car runs))
(tal (cdr runs))
(res '())
(maxtests 0))
(let* ((run-id (db:get-value-by-header run header "id"))
(run-struct (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f))
(last-update (if run-struct (dboard:rundat-last-update run-struct) 0))
(key-vals (rmt:get-key-vals run-id))
(key-vals (rmt:get-key-vals area-dat run-id))
(tests-ht (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))
;; GET RID OF dboard:get-tests-dat - it is superceded by dboard:get-tests-for-run-duplicate
;; dboard:get-tests-for-run-duplicate - returns a hash table
;; (dboard:get-tests-dat tabdat run-id last-update))
(all-test-ids (hash-table-keys tests-ht))
(num-tests (length all-test-ids)))
;; (print "run-struct: " run-struct)
|
| ︙ | | |
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
|
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
|
-
+
-
-
-
+
+
+
|
(dboard:update-tree tabdat runs-hash header tb)))
;; this calls dboard:get-tests-for-run-duplicate for each run
;;
;; create a virtual table of all the tests
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
;;
(define (dboard:update-rundat tabdat runnamepatt numruns testnamepatt keypatts)
(define (dboard:update-rundat tabdat area-dat runnamepatt numruns testnamepatt keypatts)
(let* ((access-mode (dboard:tabdat-access-mode tabdat))
(keys (dboard:tabdat-keys tabdat)) ;; (db:dispatch-query access-mode rmt:get-keys db:get-keys)))
(last-runs-update (- (dboard:tabdat-last-runs-update tabdat) 2))
(allruns (db:dispatch-query access-mode rmt:get-runs db:get-runs
runnamepatt numruns (dboard:tabdat-start-run-offset tabdat) keypatts))
;;(allruns-tree (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f))
(allruns-tree (db:dispatch-query access-mode rmt:get-runs-by-patt db:get-runs-by-patt
keys "%" #f #f #f #f 0)) ;; last-runs-update));;'("id" "runname")
(allruns-tree (rmt:get-runs-by-patt area-dat keys "%" #f #f #f #f))
;; (allruns-tree (db:dispatch-query access-mode rmt:get-runs-by-patt db:get-runs-by-patt
;; keys "%" #f #f #f #f 0)) ;; last-runs-update));;'("id" "runname")
(header (db:get-header allruns))
(runs (db:get-rows allruns)) ;; RA => Filtered as per runpatt selected
(runs-tree (db:get-rows allruns-tree)) ;; RA => Returns complete list of runs
(start-time (current-seconds))
(runs-hash (let ((ht (make-hash-table)))
(for-each (lambda (run)
(hash-table-set! ht (db:get-value-by-header run header "id") run))
|
| ︙ | | |
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
|
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
|
-
+
|
(let loop ((run (car runs))
(tal (cdr runs))
(res '())
(maxtests 0))
(let* ((run-id (db:get-value-by-header run header "id"))
(run-struct (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f))
;; (last-update (if run-struct (dboard:rundat-last-update run-struct) 0))
(key-vals (rmt:get-key-vals run-id))
(key-vals (rmt:get-key-vals area-dat run-id))
(tests-ht (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))
;; GET RID OF dboard:get-tests-dat - it is superceded by dboard:get-tests-for-run-duplicate
;; dboard:get-tests-for-run-duplicate - returns a hash table
;; (dboard:get-tests-dat tabdat run-id last-update))
(all-test-ids (hash-table-keys tests-ht))
(num-tests (length all-test-ids)))
;; (print "run-struct: " run-struct)
|
| ︙ | | |
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
|
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
|
-
+
|
(let ((newval (car values)))
(iup:attribute-set! lb "VALUE" newval)
newval))))))
(define (dashboard:update-target-selector tabdat #!key (action-proc #f))
(let* ((runconf-targs (common:get-runconfig-targets))
(key-lbs (dboard:tabdat-key-listboxes tabdat))
(db-target-dat (rmt:get-targets))
(db-target-dat (rmt:get-targets area-dat))
(header (vector-ref db-target-dat 0))
(db-targets (vector-ref db-target-dat 1))
(munge-target (lambda (x) ;; create a target vector from a string. Pad with na if needed.
(list->vector
(take (append (string-split x "/")
(make-list (length header) "na"))
(length header)))))
|
| ︙ | | |
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
|
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
|
-
+
|
(dashboard:update-run-command tabdat)))
;; used by run-controls
;;
(define (dashboard:update-tree-selector tabdat #!key (action-proc #f))
(let* ((tb (dboard:tabdat-runs-tree tabdat))
(runconf-targs (common:get-runconfig-targets))
(db-target-dat (rmt:get-targets))
(db-target-dat (rmt:get-targets area-dat))
(runs-tree-ht (dboard:tabdat-runs-tree-ht tabdat))
(header (vector-ref db-target-dat 0))
(db-targets (vector-ref db-target-dat 1))
(munge-target (lambda (x) ;; create a target vector from a string. Pad with na if needed.
(take (append (string-split x "/")
(make-list (length header) "na"))
(length header))))
|
| ︙ | | |
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
|
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
|
-
+
+
-
-
+
+
|
(define (dashboard:safe-cadr-assoc name lst)
(let ((res (assoc name lst)))
(if (and res (> (length res) 1))
(cadr res)
#f)))
(define (dboard:update-tree tabdat runs-hash runs-header tb)
(define (dboard:update-tree tabdat area-dat runs-hash runs-header tb)
(let* ((access-mode (dboard:tabdat-access-mode tabdat))
(run-ids (sort (filter number? (hash-table-keys runs-hash))
(lambda (a b)
(let* ((record-a (hash-table-ref runs-hash a))
(record-b (hash-table-ref runs-hash b))
(time-a (db:get-value-by-header record-a runs-header "event_time"))
(time-b (db:get-value-by-header record-b runs-header "event_time")))
(< time-a time-b)))))
(changed #f)
(last-runs-update (dboard:tabdat-last-runs-update tabdat))
(runs-dat (rmt:get-runs-by-patt area-dat (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)))
(runs-dat (db:dispatch-query access-mode rmt:get-runs-by-patt db:get-runs-by-patt
(dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)))
;; (db:dispatch-query access-mode rmt:get-runs-by-patt db:get-runs-by-patt
;; (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)))
(dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
(for-each (lambda (run-id)
(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
(key-vals (map (lambda (key)(db:get-value-by-header run-record runs-header key))
(dboard:tabdat-keys tabdat)))
(run-name (db:get-value-by-header run-record runs-header "runname"))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
|
| ︙ | | |
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
|
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
|
-
+
|
((> 0 (string-compare3 a-test-name b-test-name)) #f)
((< 0 (string-compare3 a-item-path b-item-path)) #t)
(else #f)))))))
(define (dashboard:run-id->tests-mindat run-id tabdat runs-hash)
(let* ((run (hash-table-ref/default runs-hash run-id #f))
(key-vals (rmt:get-key-vals run-id))
(key-vals (rmt:get-key-vals area-dat run-id))
(testnamepatt (or (dboard:tabdat-test-patts tabdat) "%/%"))
(tests-ht (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))
(tests-dat (dashboard:tests-ht->tests-dat tests-ht))
(tests-mindat (dcommon:minimize-test-data tests-dat))) ;; reduces data for display
(dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
(hash-table-set! (dboard:tabdat-last-test-dat tabdat) run-id tests-dat)
(hash-table-set! (dboard:tabdat-run-update-times tabdat) run-id (- (current-seconds) 10))
|
| ︙ | | |
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
|
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
|
-
+
+
-
-
+
+
+
-
-
+
+
-
-
+
|
(dcommon:xor-tests-mindat
(dashboard:run-id->tests-mindat src-run-id tabdat runs-hash)
(dashboard:run-id->tests-mindat dest-run-id tabdat runs-hash)
hide-clean: hide-clean)
#f)))
(define (dashboard:get-runs-hash tabdat)
(define (dashboard:get-runs-hash tabdat area-dat)
(let* ((access-mode (dboard:tabdat-access-mode tabdat))
(last-runs-update 0);;(dboard:tabdat-last-runs-update tabdat))
(runs-dat (rmt:get-runs-by-patt area-dat (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))
(runs-dat (db:dispatch-query access-mode rmt:get-runs-by-patt db:get-runs-by-patt
(dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))
;; (db:dispatch-query access-mode rmt:get-runs-by-patt db: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 (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)))
runs-hash))
(define (dashboard:runs-summary-updater commondat tabdat tb cell-lookup run-matrix)
;; (if (dashboard:database-changed? commondat tabdat context-key: 'runs-summary-rundat)
(dashboard:do-update-rundat tabdat) ;; )
(dboard:runs-summary-control-panel-updater tabdat)
(let* ((area-dat (dboard:commondat-area-dat commondat))
(let* ((last-runs-update (dboard:tabdat-last-runs-update tabdat))
(runs-dat (db:dispatch-query (dboard:tabdat-access-mode tabdat)
rmt:get-runs-by-patt db:get-runs-by-patt
(dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))
|
| ︙ | | |
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
|
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
|
-
+
-
+
-
+
|
(nonsel-color "170 170 170")
(current-mode (dboard:tabdat-runs-summary-mode tabdat)))
(if (eq? this-mode current-mode)
(iup:attribute-set! this-button "BGCOLOR" sel-color)
(iup:attribute-set! this-button "BGCOLOR" nonsel-color))
(loop (cdr buttons-left) (cdr modes-left))))))
(define (dboard:runs-summary-xor-labels-updater tabdat)
(define (dboard:runs-summary-xor-labels-updater tabdat area-dat)
(let ((source-runname-label (dboard:tabdat-runs-summary-source-runname-label tabdat))
(dest-runname-label (dboard:tabdat-runs-summary-dest-runname-label tabdat))
(mode (dboard:tabdat-runs-summary-mode tabdat)))
(when (and source-runname-label dest-runname-label)
(case mode
((xor-two-runs xor-two-runs-hide-clean)
(let* ((curr-run-id (dboard:tabdat-curr-run-id tabdat))
(prev-run-id (dboard:tabdat-prev-run-id tabdat))
(curr-runname (if curr-run-id
(rmt:get-run-name-from-id curr-run-id)
(rmt:get-run-name-from-id area-dat curr-run-id)
"None"))
(prev-runname (if prev-run-id
(rmt:get-run-name-from-id prev-run-id)
(rmt:get-run-name-from-id area-dat prev-run-id)
"None")))
(iup:attribute-set! source-runname-label "TITLE" (conc " SRC: "prev-runname" "))
(iup:attribute-set! dest-runname-label "TITLE" (conc "DEST: "curr-runname" "))))
(else
(iup:attribute-set! source-runname-label "TITLE" "")
(iup:attribute-set! dest-runname-label "TITLE" ""))))))
|
| ︙ | | |
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
|
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
|
+
|
;;
;; display and manage a single run at a time
;; This is the Run Summary tab
;;
(define (dashboard:runs-summary commondat tabdat #!key (tab-num #f))
(let* ((update-mutex (dboard:commondat-update-mutex commondat))
(area-dat (dboard:commondat-area-dat commondat))
(tb (iup:treebox
#:value 0
#:name "Runs"
#:expand "YES"
#:addexpanded "NO"
#:selection-cb
(lambda (obj id state)
|
| ︙ | | |
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
|
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
|
-
-
+
+
-
-
+
+
-
+
|
(BB> "click-cb: obj="obj" lin="lin" col="col" status="status)
;; status is corrupted on Brandon's home machine. will have to wait until after shutdown to see if it is still broken in PDX SLES
(let* ((toolpath (car (argv)))
(key (conc lin ":" col))
(test-id (hash-table-ref/default cell-lookup key -1))
(run-id (dboard:tabdat-curr-run-id tabdat))
(run-info (rmt:get-run-info run-id))
(target (rmt:get-target run-id))
(run-info (rmt:get-run-info area-dat run-id))
(target (rmt:get-target area-dat run-id))
(runname (db:get-value-by-header (db:get-rows run-info)
(db:get-header run-info) "runname"))
(test-name (db:test-get-testname (rmt:get-test-info-by-id run-id test-id)))
(testpatt (let ((tlast (rmt:tasks-get-last target runname)))
(test-name (db:test-get-testname (rmt:get-test-info-by-id area-dat run-id test-id)))
(testpatt (let ((tlast (rmt:tasks-get-last area-dat target runname)))
(if tlast
(let ((tpatt (tasks:task-get-testpatt tlast)))
(if (member tpatt '("0" 0)) ;; known bad historical value - remove in 2017
"%"
tpatt))
"%")))
(item-path (db:test-get-item-path (rmt:get-test-info-by-id run-id test-id)))
(item-path (db:test-get-item-path (rmt:get-test-info-by-id area-dat run-id test-id)))
(item-test-path (conc test-name "/" (if (equal? item-path "")
"%"
item-path)))
(status-chars (char-set->list (string->char-set status)))
(testpanel-cmd (conc toolpath " -test " (dboard:tabdat-curr-run-id tabdat) "," test-id " &")))
(BB> "status-chars=["status-chars"] status=["status"]")
(cond
|
| ︙ | | |
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
|
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
|
-
+
|
(lambda (obj)
(dcommon:examine-xterm run-id test-id)))
(iup:menu-item
(conc "Kill " item-test-path)
#:action
(lambda (obj)
;; (rmt:test-set-state-status-by-id run-id test-id "KILLREQ" #f #f)
;; (rmt:test-set-state-status-by-id area-dat run-id test-id "KILLREQ" #f #f)
(common:run-a-command
(conc "megatest -set-state-status KILLREQ,n/a -target " target
" -runname " runname
" -testpatt " item-test-path
" -state RUNNING,REMOTEHOSTSTART,LAUNCHED"))))
|
| ︙ | | |
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
|
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
|
-
+
|
" -runname " runname
" -testpatt " item-test-path
" -preclean -clean-cache"))))
(iup:menu-item
(conc "Kill " item-test-path)
#:action
(lambda (obj)
;; (rmt:test-set-state-status-by-id run-id test-id "KILLREQ" #f #f)
;; (rmt:test-set-state-status-by-id area-dat run-id test-id "KILLREQ" #f #f)
(common:run-a-command
(conc "megatest -set-state-status KILLREQ,n/a -target " target
" -runname " runname
" -testpatt " item-test-path
" -state RUNNING,REMOTEHOSTSTART,LAUNCHED"))))
(iup:menu-item
(conc "Clean "item-test-path)
|
| ︙ | | |
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
|
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
|
-
+
+
|
(lftlst '())
(hdrlst '())
(bdylst '())
(result '())
(i 0)
(btn-height (dboard:tabdat-runs-btn-height runs-dat))
(btn-fontsz (dboard:tabdat-runs-btn-fontsz runs-dat))
(cell-width (dboard:tabdat-runs-cell-width runs-dat)))
(cell-width (dboard:tabdat-runs-cell-width runs-dat))
(area-dat (dboard:commondat-area-dat commondat)))
;; controls (along bottom)
;; (set! controls (dboard:make-controls commondat runs-dat))
;; create the left most column for the run key names and the test names
(set! lftlst (list (iup:hbox
(iup:label) ;; (iup:valuator)
(apply iup:vbox
|
| ︙ | | |
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
|
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
|
-
-
+
+
-
-
+
+
-
+
|
;; (print "pressed= " pressed " x= " x " y= " y " rem=" rem " btn=" btn " string? " (string? btn))
(if (substring-index "3" btn)
(if (eq? pressed 1)
(let* ((toolpath (car (argv)))
(buttndat (hash-table-ref (dboard:tabdat-buttondat runs-dat) button-key))
(test-id (db:test-get-id (vector-ref buttndat 3)))
(run-id (db:test-get-run_id (vector-ref buttndat 3)))
(run-info (rmt:get-run-info run-id))
(target (rmt:get-target run-id))
(run-info (rmt:get-run-info area-dat run-id))
(target (rmt:get-target area-dat run-id))
(runname (db:get-value-by-header (db:get-rows run-info)
(db:get-header run-info) "runname"))
(test-name (db:test-get-testname (rmt:get-test-info-by-id run-id test-id)))
(testpatt (let ((tlast (rmt:tasks-get-last target runname)))
(test-name (db:test-get-testname (rmt:get-test-info-by-id area-dat run-id test-id)))
(testpatt (let ((tlast (rmt:tasks-get-last area-dat target runname)))
(if tlast
(let ((tpatt (tasks:task-get-testpatt tlast)))
(if (member tpatt '("0" 0)) ;; known bad historical value - remove in 2017
"%"
tpatt))
"%")))
(item-path (db:test-get-item-path (rmt:get-test-info-by-id run-id test-id)))
(item-path (db:test-get-item-path (rmt:get-test-info-by-id area-dat run-id test-id)))
(item-test-path (conc test-name "/" (if (equal? item-path "")
"%"
item-path))))
(iup:show (dashboard:popup-menu run-id test-id target runname test-name testpatt item-test-path) ;; popup-menu
#:x 'mouse
#:y 'mouse
#:modal? "NO")
|
| ︙ | | |
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
|
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
|
+
-
+
-
-
+
|
(< (db:test-get-event_time (hash-table-ref testsdat (car a)))
(db:test-get-event_time (hash-table-ref testsdat (car b))))))))))
;; run times tab data updater
;;
(define (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num)
(let* ((access-mode (dboard:tabdat-access-mode tabdat))
(area-dat (dboard:commondat-area-dat commondat))
(last-runs-update (dboard:tabdat-last-runs-update tabdat))
(runs-dat (db:dispatch-query access-mode
(runs-dat ;; (db:dispatch-query access-mode
rmt:get-runs-by-patt db:get-runs-by-patt
(dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))
|
| ︙ | | |