@@ -1412,11 +1412,11 @@ (hash-table-set! tests-draw-state 'first-time #t) ;; (hash-table-set! tests-draw-state 'scalef 1) (tests:get-full-data test-names test-records '() all-tests-registry) (set! sorted-testnames (tests:sort-by-priority-and-waiton test-records)) - ;; refer to (dboard:tabdat-keys tabdat), (dboard:tabdat-dbkeys tabdat) for keys + ;; refer to (dboard:tabcodat-keys tabdat), (dboard:tabdat-dbkeys tabdat) for keys (let* ((result (iup:vbox (dcommon:command-execution-control tabdat) (iup:split #:orientation "VERTICAL" ;; "HORIZONTAL" @@ -1456,40 +1456,53 @@ ;; browse runs as a tree. Used in both "Runs" tab and ;; in the runs control panel. ;; (define (dboard:runs-tree-browser commondat tabdat) - (let* ( - (txtbox (iup:textbox #:action (lambda (val a b) - (debug:catch-and-dump - (lambda () - ;; for the Runs view we put the list of keyvals into tabdat target - ;; for the Run Controls we put then update the run-command - (if b (dboard:tabdat-target-set! tabdat (string-split b "/"))) - (dashboard:update-run-command tabdat)) - "command-testname-selector tb action")) - #:value (dboard:test-patt->lines - (dboard:tabdat-test-patts-use tabdat)) - #:expand "HORIZONTAL" - ;; #:size "10x30" - )) + (let* ((txtbox (iup:textbox + #:action (lambda (val a b) + (debug:catch-and-dump + (lambda () + ;; for the Runs view we put the list + ;; of keyvals into tabdat target for + ;; the Run Controls we put then update + ;; the run-command + (if b (dboard:tabdat-target-set! tabdat + (string-split b "/"))) + (dashboard:update-run-command tabdat)) + "command-testname-selector tb action")) + #:value (dboard:test-patt->lines + (dboard:tabdat-test-patts-use tabdat)) + #:expand "HORIZONTAL" + ;; #:size "10x30" + )) (tb (iup:treebox #:value 0 - #:title "Runs" ;; was #:name -- iup 3.19 changed this... "Changed: [DEPRECATED REMOVED] removed the old attribute NAMEid from IupTree to avoid conflict with the common attribute NAME. Use the TITLEid attribute." + #:title "Runs" ;; was #:name -- iup 3.19 changed + ;; this... "Changed: [DEPRECATED + ;; REMOVED] removed the old attribute + ;; NAMEid from IupTree to avoid + ;; conflict with the common attribute + ;; NAME. Use the TITLEid attribute." #:expand "YES" #:addexpanded "YES" #:size "10x" #:selection-cb (lambda (obj id state) (debug:catch-and-dump (lambda () (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) - ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ?? done below when run-id is a number - (dboard:tabdat-target-set! tabdat (cdr run-path)) ;; (print "run-path: " run-path) - (iup:attribute-set! txtbox "VALUE" (string-intersperse (cdr run-path) "/")) + ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ?? + ;; done below when run-id is a number + (dboard:tabdat-target-set! tabdat (cdr run-path)) ;; (print + ;; "run-path: + ;; " + ;; run-path) + (iup:attribute-set! txtbox "VALUE" + (string-intersperse (cdr run-path) "/")) (dashboard:update-run-command tabdat) (dboard:tabdat-layout-update-ok-set! tabdat #f) (if (number? run-id) (begin ;; capture last two in tabdat. @@ -1503,12 +1516,13 @@ ;; (print "path: " (tree:node->path obj id) " run-id: " run-id) ))) (dboard:tabdat-runs-tree-set! tabdat tb) (iup:detachbox (iup:vbox + txtbox tb - txtbox)))) + )))) ;;====================================================================== ;; R U N C O N T R O L S ;;====================================================================== ;; @@ -2428,14 +2442,35 @@ #:expand "HORIZONTAL" #:max (* 10 (max (hash-table-size (dboard:tabdat-allruns-by-id tabdat)) 10)) #:min 0 #:step 0.01)) +(define (make-runs-view commondat runs-dat) + (iup:vbox + (iup:split + #:orientation "VERTICAL" ;; "HORIZONTAL" + #:value 100 + (dboard:runs-tree-browser commondat runs-dat) + (iup:vbox (iup:button "Pushme")) + #;(iup:split + #:value 100 + ;; left most block, including row names + ;; (apply iup:vbox lftlst) + ;; right hand block, including cells + (iup:vbox + #:expand "YES" + ;; the header + (apply iup:hbox (reverse hdrlst)) + (apply iup:hbox (reverse bdylst)) + (dashboard:runs-horizontal-slider runs-dat)))) + ;; controls + )) (define (make-dashboard-buttons commondat) ;; runs-sum-dat new-view-dat) (let* ((stats-dat (dboard:tabdat-make-data)) (runs-dat (dboard:tabdat-make-data)) + (runs2-dat (dboard:tabdat-make-data)) (onerun-dat (dboard:tabdat-make-data)) ;; name for run-summary structure (runcontrols-dat (dboard:tabdat-make-data)) (runtimes-dat (dboard:tabdat-make-data)) (nruns (dboard:tabdat-numruns runs-dat)) (ntests (dboard:tabdat-num-tests runs-dat)) @@ -2477,26 +2512,32 @@ (let loop ((testnum 0) (res '())) (cond ((>= testnum ntests) ;; now lftlst will be an hbox with the test keys and the test name labels - (set! lftlst (append lftlst (list (iup:hbox #:expand "HORIZONTAL" - (iup:valuator #:valuechanged_cb (lambda (obj) - (let ((val (string->number (iup:attribute obj "VALUE"))) - (oldmax (string->number (iup:attribute obj "MAX"))) - (newmax (* 10 (length (dboard:tabdat-all-test-names runs-dat))))) - (dboard:commondat-please-update-set! commondat #t) - (dboard:tabdat-start-test-offset-set! runs-dat (inexact->exact (round (/ val 10)))) - (debug:print 6 *default-log-port* "(dboard:tabdat-start-test-offset runs-dat) " (dboard:tabdat-start-test-offset runs-dat) " val: " val " newmax: " newmax " oldmax: " oldmax) - (if (< val 10) - (iup:attribute-set! obj "MAX" newmax)) - )) - #:expand "VERTICAL" - #:orientation "VERTICAL" - #:min 0 - #:step 0.01) - (apply iup:vbox (reverse res))))))) + (set! lftlst + (append lftlst + (list (iup:hbox + #:expand "HORIZONTAL" + (iup:valuator + #:valuechanged_cb (lambda (obj) + (let ((val (string->number (iup:attribute obj "VALUE"))) + (oldmax (string->number (iup:attribute obj "MAX"))) + (newmax (* 10 (length (dboard:tabdat-all-test-names runs-dat))))) + (dboard:commondat-please-update-set! commondat #t) + (dboard:tabdat-start-test-offset-set! runs-dat (inexact->exact (round (/ val 10)))) + (debug:print 6 *default-log-port* "(dboard:tabdat-start-test-offset runs-dat) " + (dboard:tabdat-start-test-offset runs-dat) " val: " val + " newmax: " newmax " oldmax: " oldmax) + (if (< val 10) + (iup:attribute-set! obj "MAX" newmax)) + )) + #:expand "VERTICAL" + #:orientation "VERTICAL" + #:min 0 + #:step 0.01) + (apply iup:vbox (reverse res))))))) (else (let ((labl (iup:button "" ;; the testname labels #:flat "YES" #:alignment "ALEFT" ; #:image img1 @@ -2604,29 +2645,10 @@ (apply iup:hbox (reverse hdrlst)) (apply iup:hbox (reverse bdylst)) (dashboard:runs-horizontal-slider runs-dat)))) controls )) - (runs-view2 (iup:vbox - (iup:split - #:orientation "VERTICAL" ;; "HORIZONTAL" - #:value 100 - (dboard:runs-tree-browser commondat runs-dat) - (iup:vbox (iup:button "Pushme")) - #;(iup:split - #:value 100 - ;; left most block, including row names - ;; (apply iup:vbox lftlst) - ;; right hand block, including cells - (iup:vbox - #:expand "YES" - ;; the header - (apply iup:hbox (reverse hdrlst)) - (apply iup:hbox (reverse bdylst)) - (dashboard:runs-horizontal-slider runs-dat)))) - ;; controls - )) (views-cfgdat (common:load-views-config)) (additional-tabnames '()) (tab-start-num 6) ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW ;; (data (dboard:tabdat-init (make-d:data))) (additional-views ;; process views-dat @@ -2667,11 +2689,11 @@ (dboard:commondat-please-update-set! commondat #t) (dboard:tabdat-layout-update-ok-set! tabdat #t))) "tabchangepos")) (dashboard:summary commondat stats-dat tab-num: 0) runs-view - runs-view2 + (make-runs-view commondat runs2-dat) (dashboard:runs-summary commondat onerun-dat tab-num: 2) ;; (dashboard:new-view db data new-view-dat tab-num: 3) (dashboard:run-controls commondat runcontrols-dat tab-num: 3) (dashboard:run-times commondat runtimes-dat tab-num: 4) ;; (dashboard:runs-summary commondat onerun-dat tab-num: 4)