@@ -170,10 +170,11 @@ (header #f) ;; header for decoding the run records (keys #f) ;; keys for this run (i.e. target components) ((numruns (string->number (or (args:get-arg "-cols") "8"))) : number) ;; ((tot-runs 0) : number) ((last-data-update 0) : number) ;; last time the data in allruns was updated + ((last-runs-update 0) : number) ;; last time we pulled the runs info to update the tree (runs-mutex (make-mutex)) ;; use to prevent parallel access to draw objects ((run-update-times (make-hash-table)) : hash-table) ;; update times indexed by run-id ((last-test-dat (make-hash-table)) : hash-table) ;; cache last tests dat by run-id ((run-db-paths (make-hash-table)) : hash-table) ;; cache the paths to the run db files @@ -567,14 +568,15 @@ ;; ;; create a virtual table of all the tests ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) ;; (define (update-rundat tabdat runnamepatt numruns testnamepatt keypatts) - (let* ( - (allruns (rmt:get-runs runnamepatt numruns (dboard:tabdat-start-run-offset tabdat) keypatts)) + (let* ((keys (rmt:get-keys)) + (last-runs-update (dboard:tabdat-last-runs-update tabdat)) + (allruns (rmt: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 (rmt:get-runs "%" #f "0" '())) + (allruns-tree (rmt:get-runs-by-patt keys "%" #f #f #f #f 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))) @@ -581,10 +583,11 @@ (for-each (lambda (run) (hash-table-set! ht (db:get-value-by-header run header "id") run)) runs-tree) ;; (vector-ref runs-dat 1)) ht)) (tb (dboard:tabdat-runs-tree tabdat))) + (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2)) (dboard:tabdat-header-set! tabdat header) ;; ;; trim runs to only those that are changing often here ;; (if (null? runs) @@ -1266,10 +1269,13 @@ (if (> (- now-time last-data-update) 5) (if (not (dboard:tabdat-running-layout tabdat)) (begin (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num) (dboard:tabdat-last-data-update-set! tabdat now-time) + ;; this is threadified to return control to the gui for a redraw. + ;; it relies on the running-layout flag to prevent overlapping + ;; calls. (thread-start! (make-thread (lambda () (dboard:tabdat-running-layout-set! tabdat #t) (dashboard:run-times-tab-layout-updater commondat tabdat tab-num) (dboard:tabdat-running-layout-set! tabdat #f)) @@ -1398,11 +1404,13 @@ (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) - (runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f))) + (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))) + (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")) @@ -1422,11 +1430,12 @@ ;; (set! colnum (+ colnum 1)) )))) run-ids))) (define (dashboard:one-run-updater commondat tabdat tb cell-lookup run-matrix) - (let* ((runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f)) + (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 (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)) @@ -1457,10 +1466,11 @@ (max-visible (max (- (dboard:tabdat-num-tests tabdat) 15) 3)) ;; (dboard:tabdat-num-tests tabdat) is proportional to the size of the window (numrows 1) (numcols 1) (changed #f) ) + (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)) (dboard:tabdat-filters-changed-set! tabdat #f) (let loop ((pass-num 0) (changed #f)) @@ -2241,11 +2251,12 @@ (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* ((runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f)) + (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-hash (let ((ht (make-hash-table))) (for-each (lambda (run) (hash-table-set! ht (db:get-value-by-header run runs-header "id") run)) (vector-ref runs-dat 1)) @@ -2259,10 +2270,11 @@ (< time-a time-b))))) (tb (dboard:tabdat-runs-tree tabdat)) (num-runs (length (hash-table-keys runs-hash))) (update-start-time (current-seconds)) (inc-mode #f)) + (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2)) ;; fill in the tree (if (and tb (not inc-mode)) (for-each (lambda (run-id) @@ -2847,12 +2859,11 @@ (dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab ;; (dboard:commondat-please-update-set! commondat #t) ;; MRW: ww36.3 - why was please update set true here? Removing it for now. ;; (dashboard:run-update commondat) ) "update buttons once")) (th2 (make-thread iup:main-loop "Main loop"))) - - (thread-start! th1) + ;; (thread-start! th1) (thread-start! th2) (thread-join! th2)))) (main)