Megatest

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

(define (mark-for-update)
  (set! *last-db-update-time* 0)
  (set! *delayed-update* 1))

;;======================================================================
;; R U N C O N T R O L
;;======================================================================

;; target populating logic
;;  
;; lb            = <vector curr-label-object next-label-object>
;; field         = target field name for this dropdown
;; referent-vals = selected value in the left dropdown
;; targets       = list of targets to use to build the dropdown
;; 
;; each node is chained: key1 -> key2 -> key3
;;
;; must select values from only apropriate targets
;;   a b c
;;   a d e
;;   a b f
;;        a/b => c f
;;
(define (dashboard:populate-target-dropdown lb referent-vals targets)
  ;; is the current value in the new list? choose new default if not
  (let* ((remvalues  (map (lambda (row)
			    (common:list-is-sublist referent-vals (vector->list row)))
			  targets))
	 (values     (map car (filter list? remvalues)))
	 (sel-valnum (iup:attribute lb "VALUE"))
	 (sel-val    (iup:attribute lb sel-valnum))
	 (val-num    0))
    ;; first check if the current value is in the new list, otherwise replace with 
    ;; first value from values
    (iup:attribute-set! lb "REMOVEITEM" "ALL")
    (for-each (lambda (val)
		(iup:attribute-set! lb "APPENDITEM" val)
		(if (equal? sel-val val)
		    (iup:attribute-set! lb "VALUE" val-num))
		(set! val-num (+ val-num 1)))
	      values)))
  

(define (dashboard:run-controls)
  (let* ((targets       (make-hash-table))
	 (runconf-targs (common:get-runconfig-targets))
	 (db-target-dat (open-run-close db:get-targets #f))
	 (header        (vector-ref db-target-dat 0))
	 (db-targets    (vector-ref db-target-dat 1))
	 (tests         (make-hash-table))
	 (action        "-runtests")
	 (cmdln         "")
	 (runlogs       (make-hash-table)))
    ;; refer to *keys*, *dbkeys* for keys
    (print "db-targets: " db-targets)
    (iup:vbox
     (iup:hbox
       ;; Target and action
      (iup:vbox
        ;; Target selectors
        (apply iup:hbox
	       (let loop ((key     (car header))
			  (remkeys (cdr header))
			  (refvals '())
			  (indx    0)
			  (lbs     '()))
		 (let ((lb (iup:listbox 
			    key 
			    #:size "x15" 
			    #:fontsize "10"
			    #:expand "YES"
			    #:dropdown "YES"
			    #:editbox "YES"
			    )))
		    ;; loop though all the targets and build the list for this dropdown
		    (dashboard:populate-target-dropdown lb refvals db-targets)
		    (if (null? remkeys)
			(append lbs (list lb))
			(loop (car remkeys)
			      (cdr remkeys)
			      (append refvals (list key))
			      (+ indx 1)
			      (append lbs (list lb))))))))))))
;;       ;; key1 key2 key3 ...
;;       ;; target entry (wild cards allowed)
;;       
;;       ;; The action
;;       (iup:hbox
;;        ;; label Action | action selector
;;        ))
;;      ;; Test/items selector
;;      (iup:hbox
;;       ;; tests
;;       ;; items
;;       ))
;;     ;; The command line
;;     (iup:hbox
;;      ;; commandline entry
;;      ;; GO button
;;      )
;;     ;; The command log monitor
;;     (iup:tabs
;;      ;; log monitor
;;      )))
   
;;======================================================================
;; R U N S 
;;======================================================================

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

	  (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 "Megatest dashboard"
      (let ((tabs (iup:tabs
		   (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)
		   (dashboard:run-controls)
		   )))
	(iup:attribute-set! tabs "TABTITLE0" "Runs")
	(iup:attribute-set! tabs "TABTITLE1" "Run Control")
	tabs)))
     (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* "%/%" '()))