Megatest

(define *delayed-update* 0)

(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))
(define-inline (dboard:uidat-get-lftcol  vec)(vector-ref vec 1))
(define-inline (dboard:uidat-get-header  vec)(vector-ref vec 2))

						    (system cmd))))))
	  (hash-table-set! *buttondat* button-key (vector 0 "100 100 100" button-key #f #f)) 
	  (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 " (current-user-name) ":" *toppath*)
      #:menu (dcommon:main-menu)
      (let* ((runs-view (iup:vbox
			 (apply iup:hbox 
				(cons (apply iup:vbox lftlst)
				      (list 
				       (iup:vbox
					;; 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)))

(if (or (args:get-arg "-rows")

(define (dashboard:been-changed)
  (> (file-modification-time (conc *toppath* "/megatest.db")) *last-db-update-time*))

(define (dashboard:set-db-update-time)
  (set! *last-db-update-time* (file-modification-time (conc *toppath* "/megatest.db"))))

(define (dashboard:run-update x)
  (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
	(begin
	  (lambda (x)

    (iup:attribute-set! general-matrix "2:1" *toppath*)
    ;; Megatest version
    (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* ((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
(define (dcommon:main-menu)
  (iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)