Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -205,11 +205,11 @@ (define (dboard:tabdat-test-patts-use vec) (let ((val (dboard:tabdat-test-patts vec)))(if val val ""))) ;; additional setters for dboard:data (define (dboard:tabdat-test-patts-set!-use vec val) - (dboard:tabdat-test-patts-set! vec(if (equal? val "") #f val))) + (dboard:tabdat-test-patts-set! vec (if (equal? val "") #f val))) (define (dboard:tabdat-make-data) (let ((dat (make-dboard:tabdat allruns-by-id: (make-hash-table) allruns: '() @@ -1086,11 +1086,11 @@ ;; (iup:frame ;; #:title "Disks Areas" (dcommon:section-matrix rawconfig "disks" "Disk area" "Path")))) (iup:frame #:title "Run statistics" - (dcommon:run-stats tabdat))))) + (dcommon:run-stats commondat tabdat))))) ;;====================================================================== ;; R U N ;;====================================================================== ;; @@ -1831,11 +1831,12 @@ (apply max (map (lambda (filen) (file-modification-time filen)) (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db")))))) (define (dashboard:monitor-changed? commondat tabdat) - (let* ((monitor-db-path (dboard:tabdat-monitor-db-path tabdat)) + (let* ((run-update-time (current-seconds)) + (monitor-db-path (dboard:tabdat-monitor-db-path tabdat)) (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path)) (file-modification-time monitor-db-path) -1))) (if (and (eq? (dboard:commondat-curr-tab-num commondat) 0) (or (> monitor-modtime *last-monitor-update-time*) @@ -1918,15 +1919,15 @@ ;; (dboard:tabdat-num-tests tabdat) ;; (dboard:tabdat-dbkeys tabdat) ;; runs-sum-dat new-view-dat)) ;; legacy setup of updaters for summary tab and runs tab ;; summary tab - (dboard:commondat-add-updater - commondat - (lambda () - (dashboard:summary-tab-updater commondat 0)) - tab-num: 0) + ;; (dboard:commondat-add-updater + ;; commondat + ;; (lambda () + ;; (dashboard:summary-tab-updater commondat 0)) + ;; tab-num: 0) ;; runs tab (dboard:commondat-add-updater commondat (lambda () (dashboard:runs-tab-updater commondat 1)) @@ -1940,23 +1941,23 @@ (if (not update-is-running) (dboard:commondat-updating-set! commondat #t)) (mutex-unlock! (dboard:commondat-update-mutex commondat)) (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update (begin - (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat) + (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat) (mutex-lock! (dboard:commondat-update-mutex commondat)) (dboard:commondat-updating-set! commondat #f) (mutex-unlock! (dboard:commondat-update-mutex commondat))) )) 1)))) (let ((th1 (make-thread (lambda () (thread-sleep! 1) (dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab (dboard:commondat-please-update-set! commondat #t) - (dashboard:run-update commondat) + ;; (dashboard:run-update commondat) ) "update buttons once")) (th2 (make-thread iup:main-loop "Main loop"))) (thread-start! th1) (thread-start! th2) (thread-join! th2)))) (main) Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -356,69 +356,71 @@ (iup:attribute-set! general-matrix "2:0" "Version") (iup:attribute-set! general-matrix "2:1" (conc megatest-version "-" (substring megatest-fossil-hash 0 4))) general-matrix)) -(define (dcommon:run-stats alldat) +(define (dcommon:run-stats commondat tabdat) (let* ((stats-matrix (iup:matrix expand: "YES")) (changed #f) (updater (lambda () - (let* ((run-stats (rmt:get-run-stats)) - (indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell)) - (row-indices (car indices)) - (col-indices (cadr indices)) - (max-row (if (null? row-indices) 1 (apply max (map cadr row-indices)))) - (max-col (if (null? col-indices) 1 - (apply max (map cadr col-indices)))) - (max-visible (max (- (dboard:tabdat-num-tests alldat) 15) 3)) - (max-col-vis (if (> max-col 10) 10 max-col)) - (numrows 1) - (numcols 1)) - (iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS") - (iup:attribute-set! stats-matrix "NUMCOL" max-col ) - (iup:attribute-set! stats-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20 - (iup:attribute-set! stats-matrix "NUMCOL_VISIBLE" max-col-vis) - (iup:attribute-set! stats-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row)) - - ;; Row labels - (for-each (lambda (ind) - (let* ((name (car ind)) - (num (cadr ind)) - (key (conc num ":0"))) - (if (not (equal? (iup:attribute stats-matrix key) name)) - (begin - (set! changed #t) - (iup:attribute-set! stats-matrix key name))))) - row-indices) - - ;; Col labels - (for-each (lambda (ind) - (let* ((name (car ind)) - (num (cadr ind)) - (key (conc "0:" num))) - (if (not (equal? (iup:attribute stats-matrix key) name)) - (begin - (set! changed #t) - (iup:attribute-set! stats-matrix key name))))) - col-indices) - - ;; Cell contents - (for-each (lambda (entry) - (let* ((row-name (car entry)) - (col-name (cadr entry)) - (value (caddr entry)) - (row-num (cadr (assoc row-name row-indices))) - (col-num (cadr (assoc col-name col-indices))) - (key (conc row-num ":" col-num))) - (if (not (equal? (iup:attribute stats-matrix key) value)) - (begin - (set! changed #t) - (iup:attribute-set! stats-matrix key value))))) - run-stats) - (if changed (iup:attribute-set! stats-matrix "REDRAW" "ALL")))))) + (if (dashboard:database-changed? commondat tabdat) + (let* ((run-stats (rmt:get-run-stats)) + (indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell)) + (row-indices (car indices)) + (col-indices (cadr indices)) + (max-row (if (null? row-indices) 1 (apply max (map cadr row-indices)))) + (max-col (if (null? col-indices) 1 + (apply max (map cadr col-indices)))) + (max-visible (max (- (dboard:tabdat-num-tests tabdat) 15) 3)) + (max-col-vis (if (> max-col 10) 10 max-col)) + (numrows 1) + (numcols 1)) + (iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS") + (iup:attribute-set! stats-matrix "NUMCOL" max-col ) + (iup:attribute-set! stats-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20 + (iup:attribute-set! stats-matrix "NUMCOL_VISIBLE" max-col-vis) + (iup:attribute-set! stats-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row)) + + ;; Row labels + (for-each (lambda (ind) + (let* ((name (car ind)) + (num (cadr ind)) + (key (conc num ":0"))) + (if (not (equal? (iup:attribute stats-matrix key) name)) + (begin + (set! changed #t) + (iup:attribute-set! stats-matrix key name))))) + row-indices) + + ;; Col labels + (for-each (lambda (ind) + (let* ((name (car ind)) + (num (cadr ind)) + (key (conc "0:" num))) + (if (not (equal? (iup:attribute stats-matrix key) name)) + (begin + (set! changed #t) + (iup:attribute-set! stats-matrix key name))))) + col-indices) + + ;; Cell contents + (for-each (lambda (entry) + (let* ((row-name (car entry)) + (col-name (cadr entry)) + (value (caddr entry)) + (row-num (cadr (assoc row-name row-indices))) + (col-num (cadr (assoc col-name col-indices))) + (key (conc row-num ":" col-num))) + (if (not (equal? (iup:attribute stats-matrix key) value)) + (begin + (set! changed #t) + (iup:attribute-set! stats-matrix key value))))) + run-stats) + (if changed (iup:attribute-set! stats-matrix "REDRAW" "ALL"))))))) (updater) - (set! dashboard:update-summary-tab updater) + (dboard:commondat-add-updater commondat updater) + ;; (set! dashboard:update-summary-tab updater) (iup:attribute-set! stats-matrix "WIDTHDEF" "40") (iup:vbox ;; (iup:label "Run statistics" #:expand "HORIZONTAL") stats-matrix))) @@ -476,40 +478,41 @@ (for-each (lambda (colname) (iup:attribute-set! servers-matrix (conc "0:" colnum) colname) (iup:attribute-set! servers-matrix "FITTOTEXT" (conc "C" colnum)) (set! colnum (+ colnum 1))) colnames) - (set! dashboard:update-servers-table updater) + ;; (set! dashboard:update-servers-table updater) + (dboard:commondat-add-updater commondat updater) ;; (iup:attribute-set! servers-matrix "WIDTHDEF" "40") - ;; (iup:hbox - ;; (iup:vbox - ;; (iup:button "Start" - ;; ;; #:size "50x" - ;; #:expand "YES" - ;; #:action (lambda (obj) - ;; (let ((cmd (conc ;; "xterm -geometry 180x20 -e \"" - ;; "megatest -server - &"))) - ;; ;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &"))) - ;; (system cmd)))) - ;; (iup:button "Stop" - ;; #:expand "YES" - ;; ;; #:size "50x" - ;; #:action (lambda (obj) - ;; (let ((cmd (conc ;; "xterm -geometry 180x20 -e \"" - ;; "megatest -stop-server 0 &"))) - ;; ;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &"))) - ;; (system cmd)))) - ;; (iup:button "Restart" - ;; #:expand "YES" - ;; ;; #:size "50x" - ;; #:action (lambda (obj) - ;; (let ((cmd (conc ;; "xterm -geometry 180x20 -e \"" - ;; "megatest -stop-server 0;megatest -server - &"))) - ;; ;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &"))) - ;; (system cmd))))) - ;; servers-matrix - ;; ))) + ;; (iup:hbox + ;; (iup:vbox + ;; (iup:button "Start" + ;; ;; #:size "50x" + ;; #:expand "YES" + ;; #:action (lambda (obj) + ;; (let ((cmd (conc ;; "xterm -geometry 180x20 -e \"" + ;; "megatest -server - &"))) + ;; ;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &"))) + ;; (system cmd)))) + ;; (iup:button "Stop" + ;; #:expand "YES" + ;; ;; #:size "50x" + ;; #:action (lambda (obj) + ;; (let ((cmd (conc ;; "xterm -geometry 180x20 -e \"" + ;; "megatest -stop-server 0 &"))) + ;; ;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &"))) + ;; (system cmd)))) + ;; (iup:button "Restart" + ;; #:expand "YES" + ;; ;; #:size "50x" + ;; #:action (lambda (obj) + ;; (let ((cmd (conc ;; "xterm -geometry 180x20 -e \"" + ;; "megatest -stop-server 0;megatest -server - &"))) + ;; ;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &"))) + ;; (system cmd))))) + ;; servers-matrix + ;; ))) servers-matrix )) ;; The main menu (define (dcommon:main-menu) @@ -917,11 +920,11 @@ ;; Text box for test patterns (iup:frame #:title "Test patterns (one per line)" (let ((tb (iup:textbox #:action (lambda (val a b) (dboard:tabdat-test-patts-set!-use - data + tabdat (dboard:lines->test-patt b)) (dashboard:update-run-command tabdat)) #:value (dboard:test-patt->lines (dboard:tabdat-test-patts-use tabdat)) #:expand "YES"