@@ -2602,149 +2602,21 @@ ;; simple-run-target procedure (x3786) ;; simple-run-target-set! procedure (x3782 val3783) ;; simple-run? procedure (x3780) -;;====================================================================== -;; Extracting the data to display for runs -;; -;; This needs to be re-entrant such that it does one column per call -;; on the zeroeth call update runs data -;; on each subsequent call update one run (configurable - could do two, three ... or update until tdelta exceeded -;; on last run reset to zeroeth -;; -;; 1. select with run filters; area, target, runname, runstate, runstatus, starttime, duration -;; - put this information into two data structures: -;; a. hash of area/target/runname => runstruct #< ordernun, id, area, target, runname, state, -;; status, starttime, duration, non-deleted testcount> -;; ordernum reflects order as received from sql query -;; b. sparsevec of id => runstruct -;; 2. for each run in runshash ordered by ordernum do: -;; retrieve data since last update for that run -;; if there is a deleted test - retrieve full data -;; if there are non-deleted tests register this run in the columns sparsevec -;; if this is the zeroeth column regenerate the rows sparsevec -;; if this column is in the visible zone update visible cells -;; -;; Other factors: -;; 1. left index handling: -;; - add test/itempaths to left index as discovered, re-order and -;; update row -> test/itempath mapping on each read run -;;====================================================================== - -;; runs is -;; get ALL runs info -;; update rdat-targ-run-id -;; update rdat-runs -;; -(define (dashboard:update-runs-data rdat) - (let* ((tb (dboard:rdat-runs-tree rdat)) - (targ-sql-filt (dboard:rdat-targ-sql-filt rdat)) - (runname-sql-filt (dboard:rdat-runname-sql-filt rdat)) - (state-sql-filt (dboard:rdat-run-state-sql-filt rdat)) - (status-sql-filt (dboard:rdat-run-status-sql-filt rdat)) - ;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo)) - (data (rmt:simple-get-runs runname-sql-filt #f #f targ-sql-filt #f)) - (numruns (length data))) - ;; store in the runsbynum vector - (dboard:rdat-runsbynum-set! rdat (list->vector data)) - ;; update runs id => runrec - ;; update targ-runid target/runname => run-id - (for-each - (lambda (runrec) - (let* ((run-id (simple-run-id runrec)) - (full-targ-runname (conc (simple-run-target runrec) "/" - (simple-run-runname runrec)))) - (debug:print 0 *default-log-port* "Update run " run-id) - (sparse-vector-set! (dboard:rdat-runs rdat) run-id runrec) - (hash-table-set! (dboard:rdat-targ-runid rdat) full-targ-runname run-id) - )) - data) - numruns)) - -;; NOTE: runnum is NOT the run-id, it is a pointer into the runsbynum vector -;; -(define (dashboard:update-run-data runnum rdat) - (let* ((curr-time (current-seconds)) - (runrec (vector-ref (dboard:rdat-runsbynum rdat) runnum)) - (run-id (simple-run-id runrec)) - (last-update (sparse-vector-ref (dboard:rdat-last-updates rdat) run-id)) - ;; filters - (testname-sql-filt (dboard:rdat-testname-sql-filt rdat)) - ;; (itempath-sql-filt (dboard:rdat-itempath-sql-filt rdat)) - (test-state-sql-filt (dboard:rdat-test-state-sql-filt rdat)) ;; not used yet - (test-status-sql-filt (dboard:rdat-test-status-sql-filt rdat)) ;; not used yet - (tests (rmt:get-tests-for-run-state-status run-id - testname-sql-filt - last-update ;; last-update - ))) - (sparse-vector-set! (dboard:rdat-last-updates rdat) run-id (- curr-time 1)) - (debug:print 0 *default-log-port* "Got " (length tests) " tests for run-id " - run-id " testname-sql-filt " testname-sql-filt " and last-update " last-update) - (length tests))) - -(define (new-runs-updater commondat rdat) - (let* ((runnum (dboard:rdat-runnum rdat)) - (start-time (current-milliseconds)) - (tot-runs #f)) - (if (eq? runnum 0)(dashboard:update-runs-data rdat)) - (set! tot-runs (vector-length (dboard:rdat-runsbynum rdat))) - (let loop ((rn runnum)) - (if (and (< (- (current-milliseconds) start-time) 250) - (< rn tot-runs)) - (let* ((newrn (if (>= runnum (vector-length (dboard:rdat-runsbynum rdat))) - 0 ;; start over - (+ rn 1)))) ;; (+ runnum 1))) - (dashboard:update-run-data rn rdat) - (dboard:rdat-runnum-set! rdat newrn) - (if (> newrn 0) - (loop newrn))))) - (if (>= (dboard:rdat-runnum rdat) tot-runs) - (dboard:rdat-runnum-set! rdat 0)) - ;; (dboard:rdat-runnum-set! rdat rn))) ;; not needed as it is set above - ;; (dboard:rdat-last-update-set! rdat (- (current-seconds) 10)) - ;; (tree:add-node tb "Runs" (string-split full-targ-runname "/")) - '())) - -(define (dboard:runs-new-matrix commondat rdat) - (iup:matrix - #:alignment1 "ALEFT" - ;; #:expand "YES" ;; "HORIZONTAL" - #:scrollbar "YES" - #:numcol 10 - #:numlin 20 - #:numcol-visible 5 ;; (min 8) - #:numlin-visible 1 - #:click-cb - (lambda (obj row col status) - (let* ((cell (conc row ":" col))) - #f)) - )) - -(define (make-runs-view commondat rdat tab-num) - ;; register an updater - (dboard:commondat-add-updater - commondat - (lambda () - (new-runs-updater commondat rdat)) - tab-num: tab-num) - - (iup:vbox - (iup:split - #:orientation "VERTICAL" ;; "HORIZONTAL" - #:value 100 - (dboard:runs-tree-new-browser commondat rdat) - (dboard:runs-new-matrix commondat rdat) - ))) +;; This is the new runs view +(include "dashboard-new-runs-view.scm") (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 (make-dboard:rdat)) ;; (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)) + (runs-browse-dat (dboard:tabdat-make-data)) (nruns (dboard:tabdat-numruns runs-dat)) (ntests (dboard:tabdat-num-tests runs-dat)) (keynames (dboard:tabdat-dbkeys runs-dat)) (nkeys (length keynames)) (runsvec (make-vector nruns)) @@ -2936,11 +2808,11 @@ (dashboard:runs-horizontal-slider runs-dat)))) controls )) (views-cfgdat (common:load-views-config)) (additional-tabnames '()) - (tab-start-num 5) ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW + (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 (let ((tab-num tab-start-num) (result '())) (for-each @@ -2982,11 +2854,12 @@ (dashboard:summary commondat stats-dat tab-num: 0) runs-view ;; (make-runs-view commondat runs2-dat 2) (dashboard:runs-summary commondat onerun-dat tab-num: 2) (dashboard:run-controls commondat runcontrols-dat tab-num: 3) - (dashboard:run-times commondat runtimes-dat tab-num: 4) + (dashboard:run-times commondat runtimes-dat tab-num: 4) + (dashboard:runs-browse commondat runs-browse-dat tab-num: 5) additional-views))) ;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c))) (iup:attribute-set! tabs "TABTITLE0" "Summary") (iup:attribute-set! tabs "TABTITLE1" "Runs") ;; (iup:attribute-set! tabs "TABTITLE2" "Runs2") @@ -2993,11 +2866,12 @@ (iup:attribute-set! tabs "TABTITLE2" "Run Summary") (iup:attribute-set! tabs "TABTITLE3" "Run Control") (iup:attribute-set! tabs "TABTITLE4" "Run Times") ;; (iup:attribute-set! tabs "TABTITLE3" "New View") ;; (iup:attribute-set! tabs "TABTITLE4" "Run Control") - + (iup:attribute-set! tabs "TABTITLE5" "Runs Browse") + ;; set the tab names for user added tabs (for-each (lambda (tab-info) (iup:attribute-set! tabs (conc "TABTITLE" (car tab-info)) (cdr tab-info))) additional-tabnames) @@ -3010,10 +2884,11 @@ (dboard:common-set-tabdat! commondat 1 runs-dat) ;;(dboard:common-set-tabdat! commondat 2 runs2-dat) (dboard:common-set-tabdat! commondat 2 onerun-dat) (dboard:common-set-tabdat! commondat 3 runcontrols-dat) (dboard:common-set-tabdat! commondat 4 runtimes-dat) + (dboard:common-set-tabdat! commondat 5 runs-browse-dat) (iup:vbox tabs ;; controls ))))