Megatest

(define (dboard:tabdat-make-data)
  (let ((dat (make-dboard:tabdat
	      allruns-by-id:        (make-hash-table)
	      allruns:              '() ;; list of run records (vectors)
	      buttondat:            (make-hash-table)
	      curr-test-ids:        (make-hash-table)
	      command:              ""
	      compact-layout:       #t
	      dbdir:                #f
	      filters-changed:      #f
	      header:               #f 
	      hide-empty-runs:      #f
	      hide-not-hide-button: #f
	      hide-not-hide:        #t
	      item-test-names:      '()

	(dboard:tabdat-runs-tree-set! tabdat tb)
	tb)
      (iup:hbox
       (iup:toggle 
	"Compact layout"
	#:fontsize 8
	#:expand "YES"
	#:value 1
	#:action (lambda (obj tstate)
		   (debug:catch-and-dump 
		    (lambda ()
		      (print "tstate: " tstate)
		      (if (eq? tstate 0)
			  (dboard:tabdat-compact-layout-set! tabdat #f)
			  (dboard:tabdat-compact-layout-set! tabdat #t))

	  (vg:drawing-yoff-set! dwg (dboard:tabdat-yadj tabdat))
	  (mutex-lock! mtx)
	  (canvas-clear! cnv)
	  (vg:draw dwg tabdat)
	  (mutex-unlock! mtx)
	  (dboard:tabdat-view-changed-set! tabdat #f)))))
  
;; doesn't work.
(define (gotoescape tabdat escape)
  (or (dboard:tabdat-layout-update-ok tabdat)
      (escape #t)))

;; run times tab
;;
(define (dashboard:run-times-tab-layout-updater commondat tabdat tab-num)
  ;; each test is an object in the run component
  ;; each run is a component
  ;; all runs stored in runslib library
  (let escapeloop ((escape #f))
    (if (and (not escape)
	     tabdat)
      (let* ((canvas-margin 10)
	     (not-done-runs (dboard:tabdat-not-done-runs tabdat))
	     (mtx           (dboard:tabdat-runs-mutex tabdat))
	     (drawing      (dboard:tabdat-drawing tabdat))
	     (runslib      (vg:get/create-lib drawing "runslib")) ;; creates and adds lib
	     (layout-start (current-milliseconds))
	     (allruns      (dboard:tabdat-allruns tabdat))

					    ;; This is the box around the tests of an iterated test
					    (vg:add-obj-to-comp runcomp (vg:make-rect-obj llx lly ulx uly
											  text:  (db:test-get-testname (hash-table-ref tests-ht (car test-ids)))
											  line-color:  (vg:rgb->number  0 0 255 a: 128)
											  font: "Helvetica -10"))
					    ;; (vg:instance-move drawing run-full-name 0 (dboard:tabdat-max-row tabdat))
					    (dboard:tabdat-view-changed-set! tabdat #t))) ;; trigger a redraw
					(if (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat)
					  (testitemloop (car tidstal)(cdr tidstal)(+ item-num 1) new-test-objs))))))
			    ;; If it is an iterated test put box around it now.
			    (if (not (null? tests-tal))
				(if #f ;; (> (- (current-seconds) update-start-time) 5)
				    (print "drawing runs taking too long")
				      (if (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat)
					(testsloop  (car tests-tal)(cdr tests-tal)(+ test-num 1)))))))
			;; placeholder box
			(dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat) 1))
			;; (let ((y  (calc-y (dboard:tabdat-max-row tabdat)))) ;;  (- sizey (* (dboard:tabdat-max-row tabdat) row-height))))
			;;   (vg:add-obj-to-comp runcomp (vg:make-rect-obj 0 y 0 y)))
			;; instantiate the component
			(let* ((extents   (vg:components-get-extents drawing runcomp))

			  (mutex-lock! mtx)
			  (vg:add-obj-to-comp runcomp outln)
			  (mutex-unlock! mtx)
			  (dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat) 2))
			  ;; (vg:instance-move drawing run-full-name 0 (dboard:tabdat-max-row tabdat))
			  ))
		      ;; end of the run handling loop 
			(if (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat)
		      (let ((newdoneruns (cons rundat doneruns)))
			(if (null? runtal)
			    (begin
			      (dboard:rundat-data-changed-set! rundat #f) 
			      (dboard:tabdat-not-done-runs-set! tabdat '())
			      (dboard:tabdat-done-runs-set! tabdat allruns))
			    (if #f ;; (> (- (current-seconds) update-start-time) 5)
				(begin
				  (print "drawing runs taking too long....  have " (length runtal) " remaining")
				  ;; (dboard:tabdat-done-runs-set! tabdat newdoneruns) ;; taking too long? stop here!
				  ;; (time (vg:draw (dboard:tabdat-drawing tabdat) #t))
				  (dboard:tabdat-not-done-runs-set! tabdat runtal))
				(begin
					(if (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat)
					    (runloop (car runtal)(cdr runtal) (+ run-num 1) newdoneruns)))))))))) ;;  new-run-start-row
	      )
	    (print "Layout end: " (current-milliseconds) " delta: " (- (current-milliseconds) layout-start))))
	(debug:print 2 *default-log-port* "no tabdat for run-times-tab-updater"))))

(define (dashboard:runs-tab-updater commondat tab-num)
  (debug:catch-and-dump 
   (lambda ()
     (let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))
       (update-rundat tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat)
		      (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")

					  tabdat
					  (dboard:lines->test-patt b))
					 (dashboard:update-run-command tabdat))
				       "command-testname-selector tb action"))
			   #:value (dboard:test-patt->lines
				    (dboard:tabdat-test-patts-use tabdat))
			   #:expand "YES"
			   #:size "10x30"
			   #:multiline "YES")))
      (set! test-patterns-textbox tb)
      tb))
;; (iup:frame
;;  #:title "Target"
;;  ;; Target selectors
;;  (apply iup:hbox