Megatest

(define *start-run-offset*  0)
(define *start-test-offset* 0)
(define *examine-test-dat* (make-hash-table))
(define *exit-started* #f)
(define *status-ignore-hash* (make-hash-table))
(define *state-ignore-hash*  (make-hash-table))

(define *last-db-update-time* 0)
(define *please-update-buttons* #t)
(define *db-file-path* (conc *toppath* "/megatest.db"))

(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)

  (let* ((c1 (map string->number (string-split color1)))
	 (c2 (map string->number (string-split color2)))
	 (delta (map (lambda (a b)(abs (- a b))) c1 c2)))
    (null? (filter (lambda (x)(> x 3)) delta))))

;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
(define (update-rundat runnamepatt numruns testnamepatt itemnamepatt keypatts)
  (let ((modtime (file-modification-time *db-file-path*)))
    (if (> modtime *last-db-update-time*)
	(begin
	  (set! *please-update-buttons* #t)
	  (set! *last-db-update-time* modtime)
  (let* ((allruns     (db:get-runs *db* runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2))
		      *start-run-offset* keypatts))
	 (header      (db:get-header allruns))
	 (runs        (db:get-rows   allruns))
	 (result      '())
	 (maxtests    0)
	 (states      (hash-table-keys *state-ignore-hash*))

		  (if (not (null? tests))
		      (set! result (cons (vector run tests key-vals) result)))))
	      runs)
    (set! *header*  header)
    (set! *allruns* result)
    ;; (set! *tot-run-count* (+ 1 (length *allruns*)))
    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 (vector-ref uidat 0) lnum))
	 (fulltestname (iup:attribute btn "TITLE"))

    ((RUNNING)          "9 131 232")
    ((KILLREQ)          "39 82 206")
    ((KILLED)           "234 101 17")
    ((NOT_STARTED)      "240 240 240")
    (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      (vector-ref uidat 0))
	 (tableheader (vector-ref uidat 1))
	 (table       (vector-ref uidat 2))
	 (coln        0))
	(set! *please-update-buttons* #f)
    (set! *alltestnamelst* '())
    ;; create a concise list of test names
    (for-each
     (lambda (rundat)
       (if (vector? rundat)
	   (let* ((testdat   (vector-ref rundat 1))
		  (testnames (map test:test-get-fullname testdat)))

		      (vector-set! buttondat 1 color)
		      (vector-set! buttondat 2 buttontxt)
		      (vector-set! buttondat 3 test)
		      (vector-set! buttondat 4 run-key)))
		(set! rown (+ rown 1))))
	    *alltestnamelst*))
	 (set! coln (+ coln 1))))
	 runs))))

(define (mkstr . x)
  (string-intersperse (map conc x) ","))

(define (update-search x val)
  ;; (print "Setting search for " x " to " val)
  (hash-table-set! *searchpatts* x val))

						  (if (eq? val 1)
						      (hash-table-set! *state-ignore-hash* "KILLED" #t)
						      (hash-table-delete! *state-ignore-hash* "KILLED")))))))
	   (iup:valuator #:valuechanged_cb (lambda (obj)
					     (let ((val (inexact->exact (round (+ 0.0 (string->number (iup:attribute obj "VALUE"))))))
						   (maxruns  *tot-run-count*)) ;;; (+ *num-runs* (length *allruns*))))
					       (set! *start-run-offset* val)
					       (set! *last-db-update-time* 0)
					       (debug:print 3 "maxruns: " maxruns ", val: " val)
					       (iup:attribute-set! obj "MAX" maxruns)))
			 #:expand "YES"
			 #:max (+ ;; *num-runs*
				(length *allruns*)))
	   ;(iup:button "inc rows" #:action (lambda (obj)(set! *num-tests* (+ *num-tests* 1))))
	   ;(iup:button "dec rows" #:action (lambda (obj)(set! *num-tests* (if (> *num-tests* 0)(- *num-tests* 1) 0))))

	       (res      '()))
      (cond
       ((>= testnum ntests)
	;; now lftlst will be an hbox with the test keys and the test name labels
	(set! lftlst (append lftlst (list (iup:hbox 
					   (iup:valuator #:valuechanged_cb (lambda (obj)
									     (let ((val (iup:attribute obj "VALUE")))
									       (set! *please-update-buttons* #t)
									       (set! *start-test-offset* (inexact->exact (round (string->number val))))
									       (iup:attribute-set! obj "MAX" (length *alltestnamelst*))
									       ) )
							 #:expand "YES" 
							 #:orientation "VERTICAL")
					   (apply iup:vbox (reverse res)))))))
       (else