Megatest

(define *verbosity* (cond
		     ((args:get-arg "-debug")(string->number (args:get-arg "-debug")))
		     ((args:get-arg "-v")    2)
		     ((args:get-arg "-q")    0)
		     (else                   1)))

(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))
(define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3))

;; (megatest-dashboard)

;(define img1 (iup:image/palette 16 16 (u8vector->blob (u8vector
;				   1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 
;				   1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 
;				   1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 
;				   1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 

	    maxtests))
	*num-tests*))) ;; FIXME, naughty coding eh?

(define *collapsed* (make-hash-table))
; (define *row-lookup* (make-hash-table)) ;; testname => (rownum lableobj)

(define (toggle-hide lnum) ; fulltestname)
  (let* ((btn (vector-ref (dboard:uidat-get-lftcol uidat) lnum))
	 (fulltestname (iup:attribute btn "TITLE"))
	 (parts        (string-split fulltestname "("))
	 (basetestname (if (null? parts) "" (car parts))))
    ;(print "Toggling " basetestname " currently " (hash-table-ref/default *collapsed* basetestname #f))
    (if (hash-table-ref/default *collapsed* basetestname #f)
	(begin
	  ;(iup:attribute-set! btn "FGCOLOR" "0 0 0")

    ;;     		 (if (equal? (car partsa)(car partsb)) ;; same test
    ;;     		     (> lenb lena)
    ;;     		     #t)
    ;;     		 #t))))))
			     
(define (update-labels uidat)
  (let* ((rown    0)
	 (keycol  (dboard:uidat-get-keycol uidat))
	 (lftcol  (dboard:uidat-get-lftcol uidat))
	 (numcols (vector-length lftcol))
	 (maxn    (- numcols 1))
	 (allvals (make-vector numcols "")))
    (for-each (lambda (name)
		(if (<= rown maxn)

		    (vector-set! allvals rown name)) ;)
		(set! rown (+ 1 rown)))
	      *alltestnamelst*)



    (let loop ((i 0))
      (let* ((lbl    (vector-ref lftcol i))
	     (keyval (vector-ref keycol i))
	     (oldval (iup:attribute lbl "TITLE"))
	     (newval (vector-ref allvals i)))
	(if (not (equal? oldval newval))
	    (let ((munged-val (let ((parts (string-split newval "(")))
				(if (> (length parts) 1)(conc "  " (car (string-split (cadr parts) ")"))) newval))))
	      (vector-set! keycol i newval)
	      (iup:attribute-set! lbl "TITLE" munged-val)))
	(iup:attribute-set! lbl "FGCOLOR" (if (hash-table-ref/default *collapsed* newval #f) "0 112 112" "0 0 0"))
	(if (< i maxn)
	    (loop (+ i 1)))))))

(define (get-color-for-state-status state status)
  (case (string->symbol state)
    ((COMPLETED)

    (else               "192 192 192")))

(define (update-buttons uidat numruns numtests)
  (if *please-update-buttons*
      (let* ((runs        (if (> (length *allruns*) numruns)
			      (take-right *allruns* numruns)
			      (pad-list *allruns* numruns)))
	     (lftcol      (dboard:uidat-get-lftcol uidat))
	     (tableheader (dboard:uidat-get-header uidat))
	     (table       (dboard:uidat-get-runsvec uidat))
	     (coln        0))
	(set! *please-update-buttons* #f)
	(set! *alltestnamelst* '())
	;; create a concise list of test names
	(for-each
	 (lambda (rundat)
	   (if (vector? rundat)

  (hash-table-set! *searchpatts* x val))

(define (make-dashboard-buttons nruns ntests keynames)
  (let* ((nkeys   (length keynames))
	 (runsvec (make-vector nruns))
	 (header  (make-vector nruns))
	 (lftcol  (make-vector ntests))
	 (keycol  (make-vector ntests))
	 (controls '())
	 (lftlst  '())
	 (hdrlst  '())
	 (bdylst  '())
	 (result  '())
	 (i       0))
    ;; controls (along bottom)

			   #:action (lambda (obj unk val)
				      (set! *last-db-update-time* 0)
				      (update-search "test-name" val)))
	      (iup:textbox #:size "60x15" #:fontsize "10" #:value "%"
			   #:action (lambda (obj unk val)
				      (set! *last-db-update-time* 0)
				      (update-search "item-name" val)))))
	    (iup:vbox
	     (iup:hbox
	      (iup:button "Sort Order" #:acton (lambda (obj)(toggle-sort-order))))
	     (iup:hbox
	      (iup:button "Quit" #:action (lambda (obj)(sqlite3:finalize! *db*)(exit)))
	      (iup:button "Monitor" #:action (lambda (obj)(system (conc (car (argv))" -guimonitor &")))))
	     ))
	   ;; (iup:button "<-  Left" #:action (lambda (obj)(set! *start-run-offset*  (+ *start-run-offset* 1))))
	   ;; (iup:button "Up     ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0))))
	   ;; (iup:button "Down   v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1)))))
	   ;; (iup:button "Right ->" #:action (lambda (obj)(set! *start-run-offset*  (if (> *start-run-offset* 0)(- *start-run-offset* 1) 0))))
	   (iup:frame 
	    #:title "hide"

									       ))
							 #:expand "YES" 
							 #:orientation "VERTICAL")
					   (apply iup:vbox (reverse res)))))))
       (else
	(let ((labl  (iup:button "" 
				 #:flat "YES" 
				 #:alignment "ALEFT"
				 ; #:image img1
				 ; #:impress img2
				 #:size "100x15"
				 #:fontsize "10"
				 #:action (lambda (obj)
					    (set! *last-db-update-time* 0)
					    (toggle-hide testnum))))) ;; (iup:attribute obj "TITLE"))))

	       (cons (apply iup:vbox lftlst)
		     (list 
		      (iup:vbox
		       ;; the header
		       (apply iup:hbox (reverse hdrlst))
		       (apply iup:hbox (reverse bdylst))))))
       controls)))
    (vector keycol lftcol header runsvec)))

(if (or (args:get-arg "-rows")
	(get-environment-variable "DASHBOARDROWS" ))
    (begin
        (set! *num-tests* (string->number (or (args:get-arg "-rows")
					      (get-environment-variable "DASHBOARDROWS"))))
	(update-rundat "%" *num-runs* "%" "%" '()))