| ︙ | | |
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
+
|
start-row
run-start-row
max-row
running-layout
originx
originy
layout-update-ok
compact-layout
;; Controls used to launch runs etc.
command ;; for run control this is the command being built up
command-tb
key-listboxes
key-lbs
run-name ;; from run name setting widget
|
| ︙ | | |
255
256
257
258
259
260
261
262
263
264
265
266
267
268
|
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
|
+
|
(define (dboard:tabdat-make-data)
(let ((dat (make-dboard:tabdat
allruns-by-id: (make-hash-table)
allruns: '() ;; list of run records (vectors)
buttondat: (make-hash-table)
curr-test-ids: (make-hash-table)
command: ""
compact-layout: #f
dbdir: #f
filters-changed: #f
header: #f
hide-empty-runs: #f
hide-not-hide-button: #f
hide-not-hide: #t
item-test-names: '()
|
| ︙ | | |
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
|
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
|
-
+
+
|
(set! *alltestnamelst* (let ((xl (if (> (length *alltestnamelst*) (dboard:tabdat-start-test-offset tabdat))
(drop *alltestnamelst* (dboard:tabdat-start-test-offset tabdat))
'())))
(append xl (make-list (- (dboard:tabdat-num-tests tabdat) (length xl)) ""))))
(update-labels uidat)
(for-each
(lambda (rundat)
(if (not rundat) ;; handle padded runs
(if (or (not rundat) ;; handle padded runs
(not (dboard:rundat-run rundat)))
;; ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration
(set! rundat (dboard:rundat-make-init
key-vals: (map (lambda (x) "")(dboard:tabdat-keys tabdat)))))
(let* ((run (dboard:rundat-run rundat))
(testsdat-by-name (dboard:rundat-tests-by-name rundat))
(key-val-dat (dboard:rundat-key-vals rundat))
(run-id (db:get-value-by-header run (dboard:tabdat-header tabdat) "id"))
|
| ︙ | | |
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
|
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(dboard:tabdat-view-changed-set! tabdat #t))
(debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id))))
"treebox"))
;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
)))
(dboard:tabdat-runs-tree-set! tabdat tb)
tb)
(iup:hbox
(iup:toggle
"Compact layout"
#:fontsize 8
#:expand "YES"
#:action (lambda (obj tstate)
(debug:catch-and-dump
(lambda ()
(print "tstate: " tstate)
(if (eq? tstate 0)
(dboard:tabdat-compact-layout-set! tabdat #f)
(dboard:tabdat-compact-layout-set! tabdat #t))
(dboard:tabdat-last-filter-str-set! tabdat "")
)
"text-list-toggle-box"))))
(dcommon:command-runname-selector commondat tabdat tab-num: tab-num)
(dcommon:command-testname-selector commondat tabdat update-keyvals))
(iup:vbox
(let* ((cnv-obj (iup:canvas
;; #:size "500x400"
#:expand "YES"
#:scrollbar "YES"
|
| ︙ | | |
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
|
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
|
-
-
+
+
+
|
;;
(define (dashboard:run-times-tab-layout-updater commondat tabdat tab-num)
;; each test is an object in the run component
;; each run is a component
;; all runs stored in runslib library
(if tabdat
(let* ((canvas-margin 10)
(row-height 10)
(cnv (dboard:tabdat-cnv tabdat)))
(cnv (dboard:tabdat-cnv tabdat))
(compact-layout (dboard:tabdat-compact-layout tabdat))
(row-height (if compact-layout 2 10)))
(dboard:tabdat-layout-update-ok-set! tabdat #t)
(if (canvas? cnv)
(let*-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
((originx originy) (canvas-origin cnv))
((calc-y) (lambda (rownum)
(- (/ sizey 2)
(* rownum row-height))))
|
| ︙ | | |
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
|
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
|
-
+
-
+
+
+
+
+
|
(status (db:test-get-status testdat))
(test-fullname (conc test-name "/" item-path))
(name-color (gutils:get-color-for-state-status state status))
(new-test-objs
(let loop ((rownum 0)) ;; new-run-start-row)) ;; (+ start-row 1)))
(if (dashboard:row-collision rowhash rownum event-time end-time)
(loop (+ rownum 1))
(let* ((title (if iterated item-path test-name))
(let* ((title (if iterated (if compact-layout #f item-path) test-name))
(lly (calc-y rownum)) ;; (- sizey (* rownum row-height)))
(uly (+ lly row-height))
(use-end (if (< (- end-time event-time) 3)(+ event-time 3) end-time)) ;; if short grow it a little to give the user something to click on
(obj (vg:make-rect-obj event-time lly use-end uly
fill-color: (vg:iup-color->number (car name-color))
text: title
font: "Helvetica -10"))
(bar-end (+ 5 (max use-end (+ 3 event-time (* (string-length title) 10)))))) ;; 8 pixels per letter
(bar-end (+ 5 (max use-end
(+ 3 event-time
(if compact-layout
0
(* (string-length title) 10))))))) ;; 8 pixels per letter
;; (if iterated
;; (dashboard:add-bar rowhash (- rownum 1) event-time end-time num-rows: (+ 1 num-items))
;; (if (not first-rownum)
;; (begin
;; (dashboard:row-collision rowhash (- rownum 1) event-time end-time num-rows: num-items)
;; (set! first-rownum rownum)))
(dboard:tabdat-max-row-set! tabdat (max (+ curr-run-start-row rownum)
|
| ︙ | | |