Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -135,10 +135,12 @@ (define *db-file-path* (conc *toppath* "/megatest.db")) (define *tests-sort-reverse* #f) (define *hide-empty-runs* #f) +(define *current-tab-number* 0) + (debug:setup) (define uidat #f) (define-inline (dboard:uidat-get-keycol vec)(vector-ref vec 0)) @@ -843,11 +845,11 @@ (vector-set! testvec testnum butn) (loop runnum (+ testnum 1) testvec (cons butn res)))))) ;; now assemble the hdrlst and bdylst and kick off the dialog (iup:show (iup:dialog - #:title (conc "Megatest dashboard " *toppath*) + #:title (conc "Megatest dashboard " (current-user-name) ":" *toppath*) #:menu (dcommon:main-menu) (let* ((runs-view (iup:vbox (apply iup:hbox (cons (apply iup:vbox lftlst) (list @@ -855,14 +857,17 @@ ;; the header (apply iup:hbox (reverse hdrlst)) (apply iup:hbox (reverse bdylst)))))) controls)) (tabs (iup:tabs + #:tabchangepos-cb (lambda (obj curr prev) + (set! *current-tab-number* curr)) (dashboard:summary) runs-view (dashboard:run-controls) ))) + ;; (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" "Run Control") tabs))) (vector keycol lftcol header runsvec))) @@ -889,25 +894,24 @@ (define (dashboard:set-db-update-time) (set! *last-db-update-time* (file-modification-time (conc *toppath* "/megatest.db")))) (define (dashboard:run-update x) - (update-buttons uidat *num-runs* *num-tests*) - ;; (if (dashboard:been-changed) - (begin - (update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs* - (hash-table-ref/default *searchpatts* "test-name" "%/%") - ;; (hash-table-ref/default *searchpatts* "item-name" "%") - (let ((res '())) - (for-each (lambda (key) - (if (not (equal? key "runname")) - (let ((val (hash-table-ref/default *searchpatts* key #f))) - (if val (set! res (cons (list key val) res)))))) - *dbkeys*) - res)) - ; (dashboard:set-db-update-time) - )) + (case *current-tab-number* + ((1) ;; The runs table is active + (update-buttons uidat *num-runs* *num-tests*) + (update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs* + (hash-table-ref/default *searchpatts* "test-name" "%/%") + ;; (hash-table-ref/default *searchpatts* "item-name" "%") + (let ((res '())) + (for-each (lambda (key) + (if (not (equal? key "runname")) + (let ((val (hash-table-ref/default *searchpatts* key #f))) + (if val (set! res (cons (list key val) res)))))) + *dbkeys*) + res)) ;; (dashboard:set-db-update-time) + ))) (cond ((args:get-arg "-run") (let ((runid (string->number (args:get-arg "-run")))) (if runid Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -108,64 +108,67 @@ (iup:attribute-set! general-matrix "3:0" "Megatest version") (iup:attribute-set! general-matrix "3:1" megatest-version) general-matrix)) (define (dcommon:run-stats) - (let* ((run-stats (mt:get-run-stats)) - (indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell)) - (max-row (apply max (map cadr (car indices)))) - (max-col (apply max (map cadr (cadr indices)))) - (max-visible (max (- *num-tests* 15) 3)) - (stats-matrix (iup:matrix - ;; #:alignment1 "ALEFT" - #:expand "YES" ;; "HORIZONTAL" - #:numcol max-col - #:numlin (if (< max-row max-visible) max-visible max-row) ;; min of 20 - #:numcol-visible max-col - #:numlin-visible (if (> max-row max-visible) max-visible max-row))) - (numrows 1) - (numcols 1) - (set-cell (lambda (rnum cnum rname cname v) ;; rownum colnum value - (print "proc called: " rnum " " cnum " " rname " " cname " " v) - (if (> rnum numrows) - (begin - ;; add rows numrows to r - (debug:print 0 "Extending matrix from " numrows " to " rnum) - (iup:attribute-set! stats-matrix "ADDLIN" (conc numrows "-" (- rnum numrows))) - (set! numrows rnum))) - (if (> cnum numcols) - (begin - ;; add rows numrows to r - (debug:print 0 "Extending matrix from " numcols " to " cnum) - (iup:attribute-set! stats-matrix "ADDLIN" (conc numcols "-" (- rnum numcols))) - (set! numcols cnum))) - (debug:print 0 "Setting row " rnum ", col " cnum " to " v) - (iup:attribute-set! stats-matrix (conc rnum ":" cnum) v))) - (row-indices (car indices)) - (col-indices (cadr indices))) - (iup:attribute-set! stats-matrix "WIDTHDEF" "40") - ;; Row labels - (for-each (lambda (ind) - (let ((name (car ind)) - (num (cadr ind))) - (iup:attribute-set! stats-matrix (conc num ":0") name))) - row-indices) - ;; Col labels - (for-each (lambda (ind) - (let ((name (car ind)) - (num (cadr ind))) - (iup:attribute-set! stats-matrix (conc "0:" num) 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)))) - (iup:attribute-set! stats-matrix (conc row-num ":" col-num) value))) - run-stats) + (let* ((stats-matrix (iup:matrix expand: "YES")) + (updater (lambda () + (let* ((run-stats (mt:get-run-stats)) + (indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell)) + (max-row (apply max (map cadr (car indices)))) + (max-col (apply max (map cadr (cadr indices)))) + (max-visible (max (- *num-tests* 15) 3)) + (numrows 1) + (numcols 1) + (set-cell (lambda (rnum cnum rname cname v) ;; rownum colnum value + (print "proc called: " rnum " " cnum " " rname " " cname " " v) + (if (> rnum numrows) + (begin + ;; add rows numrows to r + (debug:print 0 "Extending matrix from " numrows " to " rnum) + (iup:attribute-set! stats-matrix "ADDLIN" (conc numrows "-" (- rnum numrows))) + (set! numrows rnum))) + (if (> cnum numcols) + (begin + ;; add rows numrows to r + (debug:print 0 "Extending matrix from " numcols " to " cnum) + (iup:attribute-set! stats-matrix "ADDLIN" (conc numcols "-" (- rnum numcols))) + (set! numcols cnum))) + (debug:print 0 "Setting row " rnum ", col " cnum " to " v) + (iup:attribute-set! stats-matrix (conc rnum ":" cnum) v))) + (row-indices (car indices)) + (col-indices (cadr indices))) + (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) + (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))) + (iup:attribute-set! stats-matrix (conc num ":0") name))) + row-indices) + + ;; Col labels + (for-each (lambda (ind) + (let ((name (car ind)) + (num (cadr ind))) + (iup:attribute-set! stats-matrix (conc "0:" num) 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)))) + (iup:attribute-set! stats-matrix (conc row-num ":" col-num) value))) + run-stats))))) + (updater) + (iup:attribute-set! stats-matrix "WIDTHDEF" "40") (iup:vbox (iup:label "Run statistics" #:expand "HORIZONTAL") stats-matrix))) ;; The main menu