Megatest

	    ((get-all-run-ids)              (db:get-all-run-ids dbstruct))
	    ((get-prev-run-ids)             (apply db:get-prev-run-ids dbstruct params))
	    ((get-run-ids-matching-target)  (apply db:get-run-ids-matching-target dbstruct params))
	    ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct params))
	    ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct params))
	    ((get-main-run-stats)           (apply db:get-main-run-stats dbstruct params))
	    ((get-var)                      (apply db:get-var dbstruct params))


	    ;; STEPS
	    ((get-steps-data)               (apply db:get-steps-data dbstruct params))
	    ((get-steps-for-test)           (apply db:get-steps-for-test dbstruct params))

	    ;; TEST DATA
	    ((read-test-data)               (apply db:read-test-data dbstruct params))

      (exit)))

(if (not (launch:setup))
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))













;; create a stuct for all the miscellaneous state
























;;
(defstruct d:alldat 
  allruns 
  allruns-by-id
  buttondat 



  curr-tab-num

  dbdir
  dbfpath
  dbkeys 
  dblocal
  filters-changed
  header      
  hide-empty-runs
  hide-not-hide  ;; toggle for hide/not hide
  hide-not-hide-button
  hide-not-hide-tabs
  item-test-names
  keys
  last-db-update 


  num-tests
  numruns
  please-update  
  ro






  searchpatts
  start-run-offset
  start-test-offset
  state-ignore-hash

  status-ignore-hash





  tot-runs   
  update-mutex
  updaters
  updating
  useserver  
  )

(define *alldat* (make-d:alldat


		  header: #f 


		  allruns: '()



		  allruns-by-id: (make-hash-table)

		  buttondat: (make-hash-table)
		  searchpatts: (make-hash-table)
		  numruns: 16
		  last-db-update: 0
		  please-update: #t
		  updating: #f
		  update-mutex: (make-mutex)
		  item-test-names: '()
		  num-tests: 15
		  start-run-offset: 0
		  start-test-offset: 0
		  status-ignore-hash: (make-hash-table)
		  state-ignore-hash: (make-hash-table)



		  hide-empty-runs: #f
		  hide-not-hide: #t
		  hide-not-hide-button: #f
		  hide-not-hide-tabs: #f


		  curr-tab-num: 0

		  updaters: (make-hash-table)



		  filters-changed: #f



		  ))

















;; data for runs, tests etc
;;
(defstruct d:rundat
  ;; new system
  runs-index    ;; target/runname => colnum
  tests-index   ;; testname/itempath => rownum
  matrix-dat    ;; vector of vectors rows/cols
  )

(define (d:rundat-make-init)
  (make-d:rundat
   runs-index: (make-hash-table)
   tests-index: (make-hash-table)
   matrix-dat: (make-sparse-array)))

(defstruct d:testdat
  id       ;; testid
  state    ;; test state
  status   ;; test status
  )

(define (d:rundat-get-col-num dat target runname force-set)
  (let* ((runs-index (d:rundat-runs-index dat))
	 (col-name   (conc target "/" runname))
	 (res        (hash-table-ref/default runs-index col-name #f)))
    (if res
	res
	(if force-set
	    (let ((max-col-num (+ 1 (apply max -1 (hash-table-values runs-index)))))
	      (hash-table-set! runs-index col-name max-col-num)
	      max-col-num)))))

(define (d:rundat-get-row-num dat testname itempath force-set)
  (let* ((tests-index (d:rundat-runs-index dat))
	 (row-name    (conc testname "/" itempath))
	 (res         (hash-table-ref/default runs-index row-name #f)))
    (if res
	res
	(if force-set
	    (let ((max-row-num (+ 1 (apply max -1 (hash-table-values tests-index)))))
	      (hash-table-set! runs-index row-name max-row-num)
	      max-row-num)))))

;; default is to NOT set the cell if the column and row names are not pre-existing
;;
(define (d:rundat-set-test-cell dat target runname testname itempath test-id state status #!key (force-set #f))
  (let* ((col-num  (d:rundat-get-col-num dat target runname force-set))
	 (row-num  (d:rundat-get-row-num dat testname itempath force-set)))
    (if (and row-num col-num)
	(let ((tdat (d:testdat 
		     id: test-id
		     state: state
		     status: status)))
	  (sparse-array-set! (d:rundat-matrix-dat dat) col-num row-num tdat)
	  tdat)
	#f)))





(d:alldat-useserver-set! *alldat* (cond
				   ((args:get-arg "-use-local") #f)
				   ((configf:lookup *configdat* "dashboard" "use-server")
				    (let ((ans (config:lookup *configdat* "dashboard" "use-server")))
				      (if (equal? ans "yes") #t #f)))
				   (else #t)))
(define *dashboard-mode* (string->symbol (or (configf:lookup *configdat* "dashboard" "mode") "dashboard")))

(d:alldat-dbdir-set! *alldat* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(d:alldat-dblocal-set! *alldat* (make-dbr:dbstruct path:  (d:alldat-dbdir *alldat*)
						   local: #t))
(d:alldat-dbfpath-set! *alldat* (db:dbfile-path 0))

;; HACK ALERT: this is a hack, please fix.
(d:alldat-ro-set! *alldat* (not (file-read-access? (d:alldat-dbfpath *alldat*))))

(d:alldat-keys-set! *alldat* (if (d:alldat-useserver *alldat*)
				 (rmt:get-keys)
				 (db:get-keys (d:alldat-dblocal *alldat*))))
(d:alldat-dbkeys-set! *alldat* (append (d:alldat-keys *alldat*) (list "runname")))
(d:alldat-tot-runs-set! *alldat* (if (d:alldat-useserver *alldat*)
				     (rmt:get-num-runs "%")
				     (db:get-num-runs (d:alldat-dblocal *alldat*) "%")))
;;
(define *exit-started* #f)
;; *updaters* (make-hash-table))

;; sorting global data (would apply to many testsuites so leave it global for now)
;;
(define *tests-sort-options* (vector (vector "Sort +a" 'testname   "ASC")
				     (vector "Sort -a" 'testname   "DESC")
				     (vector "Sort +t" 'event_time "ASC")
				     (vector "Sort -t" 'event_time "DESC")

	3)))

(define (get-curr-sort)
  (vector-ref *tests-sort-options* *tests-sort-reverse*))

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

(if (get-environment-variable "MT_RUN_AREA_HOME")(change-directory (get-environment-variable "MT_RUN_AREA_HOME")))

	    test1-older)
	(if same-time
	    (string>? test-name1 test-name2)
	    test1-older))))

;; This is roughly the same as dboard:get-tests-dat, should merge them if possible
;;
(define (dboard:get-tests-for-run-duplicate data run-id run testnamepatt key-vals)
  (let* ((states      (hash-table-keys (d:alldat-state-ignore-hash data)))
	 (statuses    (hash-table-keys (d:alldat-status-ignore-hash data)))
	 (sort-info   (get-curr-sort))
	 (sort-by     (vector-ref sort-info 1))
	 (sort-order  (vector-ref sort-info 2))
	 (bubble-type (if (member sort-order '(testname))
			  'testname
			  'itempath))
	 (prev-dat    (let ((rec (hash-table-ref/default (d:alldat-allruns-by-id data) run-id #f)))
			(if rec rec (vector run '() key-vals -100)))) ;; -100 is before time began
	 (prev-tests  (vector-ref prev-dat 1))
	 (last-update (vector-ref prev-dat 3))
	 (tmptests    (if (d:alldat-useserver data)
			  (rmt:get-tests-for-run run-id testnamepatt states statuses
						 #f #f
						 (d:alldat-hide-not-hide data)
						 sort-by
						 sort-order
						 'shortlist
						 (if (d:alldat-filters-changed data)
						     0
						     last-update)
						 *dashboard-mode*) ;; use dashboard mode
			  (db:get-tests-for-run (d:alldat-dblocal data) run-id testnamepatt states statuses
						#f #f
						(d:alldat-hide-not-hide data)
						sort-by
						sort-order
						'shortlist
						(if (d:alldat-filters-changed data)
						    0
						    last-update)
						*dashboard-mode*)))
	 (tests       (let ((newdat (filter
				     (lambda (x)
				       (not (equal? (db:test-get-state x) "DELETED"))) ;; remove deleted tests but do it after merging
				     (delete-duplicates (if (d:alldat-filters-changed data)
							    tmptests
							    (append tmptests prev-tests))
							(lambda (a b)
							  (eq? (db:test-get-id a)(db:test-get-id b)))))))
			(if (eq? *tests-sort-reverse* 3) ;; +event_time
			    (sort newdat dboard:compare-tests)
			    newdat))))
    (vector-set! prev-dat 3 (- (current-seconds) 2)) ;; go back two seconds in time to ensure all changes are captured.
    ;; (debug:print 0 *default-log-port* "(dboard:get-tests-for-run-duplicate: filters-changed=" (d:alldat-filters-changed data) " last-update=" last-update " got " (length tmptests) " test records for run " run-id)
    tests))

;; create a virtual table of all the tests
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
(define (update-rundat data runnamepatt numruns testnamepatt keypatts)
  (let* ((referenced-run-ids '())
	 (allruns     (if (d:alldat-useserver data)
			  (rmt:get-runs runnamepatt numruns (d:alldat-start-run-offset data) keypatts)
			  (db:get-runs (d:alldat-dblocal data) runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2))
				       (d:alldat-start-run-offset data) keypatts)))
	 (header      (db:get-header allruns))
	 (runs        (db:get-rows   allruns))
	 (result      '())
	 (maxtests    0))
    ;; 
    ;; trim runs to only those that are changing often here
    ;; 
    (for-each (lambda (run)
		(let* ((run-id      (db:get-value-by-header run header "id"))
		       (key-vals    (if (d:alldat-useserver data) 
					(rmt:get-key-vals run-id)
					(db:get-key-vals (d:alldat-dblocal data) run-id)))
		       (tests       (dboard:get-tests-for-run-duplicate data run-id run testnamepatt key-vals)))
		  ;; NOTE: bubble-up also sets the global (d:alldat-item-test-names data)
		  ;; (tests       (bubble-up tmptests priority: bubble-type))
		  ;; NOTE: 11/01/2013 This routine is *NOT* getting called excessively.
		  ;; (debug:print 0 *default-log-port* "Getting data for run " run-id " with key-vals=" key-vals)
		  ;; Not sure this is needed?
		  (if (not (null? tests))
		      (begin
			(set! referenced-run-ids (cons run-id referenced-run-ids))
			(if (> (length tests) maxtests)
			    (set! maxtests (length tests)))
			(if (or (not (d:alldat-hide-empty-runs data)) ;; this reduces the data burden when set
				(not (null? tests)))
			    (let ((dstruct (vector run tests key-vals (- (current-seconds) 10))))
			      (hash-table-set! (d:alldat-allruns-by-id data) run-id dstruct)
			      (set! result (cons dstruct result))))))))
	      runs)

    (d:alldat-header-set! data header)
    (d:alldat-allruns-set! data result)
    (debug:print-info 6 *default-log-port* "(d:alldat-allruns data) has " (length (d:alldat-allruns data)) " runs")
    maxtests))

(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

	       (res   (vector "" "")))
	   (vector-set! res 0 (car splst))
	   (if (> (length splst) 1)
	       (vector-set! res 1 (car (string-split (cadr splst) ")"))))
	   res))
       lst))

(define (collapse-rows inlst)
  (let* ((sort-info   (get-curr-sort))
	 (sort-by     (vector-ref sort-info 1))
	 (sort-order  (vector-ref sort-info 2))
	 (bubble-type (if (member sort-order '(testname))
			  'testname
			  'itempath))
	 (newlst      (filter (lambda (x)
				(let* ((tparts    (string-split x "("))
				       (basetname (if (null? tparts) x (car tparts))))
					;(print "x " x " tparts: " tparts " basetname: " basetname)
				  (cond
				   ((string-match blank-line-rx x) #f)
				   ((equal? x basetname) #t)
				   ((hash-table-ref/default *collapsed* basetname #f) 
					;(print "Removing " basetname " from items")
				    #f)
				   (else #t))))
			      inlst))
	 (vlst         (run-item-name->vectors newlst))
	 (vlst2        (bubble-up vlst priority: bubble-type)))
    (map (lambda (x)
	   (if (equal? (vector-ref x 1) "")
	       (vector-ref x 0)
	       (conc (vector-ref x 0) "(" (vector-ref x 1) ")")))
	 vlst2)))

(define (update-labels uidat)

			  (set! tnames (append tnames (list tname)))))))
	      test-dats)
    tnames))

;; Bubble up the top tests to above the items, collect the items underneath
;; all while preserving the sort order from the SQL query as best as possible.
;;
(define (bubble-up test-dats #!key (priority 'itempath))
  (if (null? test-dats)
      test-dats
      (begin
	(let* ((tnames   '())                ;; list of names used to reserve order
	       (tests    (make-hash-table))  ;; hash of lists, used to build as we go
	       (itemized (get-itemized-tests test-dats)))
	  (for-each 

	       (if (equal? ipath "")
		   ;; This a top level, prepend it
		   (hash-table-set! tests tname (cons testdat (hash-table-ref/default tests tname '())))
		   ;; This is item, append it
		   (hash-table-set! tests tname (append (hash-table-ref/default tests tname '())(list testdat))))))
	   test-dats)
	  ;; Set all tests with items 
	  (d:alldat-item-test-names-set! *alldat* (append (if (null? tnames)
							      '()
							      (filter (lambda (tname)
									(let ((tlst (hash-table-ref tests tname)))
									  (and (list tlst)
									       (> (length tlst) 1))))
								      tnames))
							  (d:alldat-item-test-names *alldat*)))
	  (let loop ((hed (car tnames))
		     (tal (cdr tnames))
		     (res '()))
	    (let ((newres (append res (hash-table-ref tests hed))))
	      (if (null? tal)
		  newres
		  (loop (car tal)(cdr tal) newres))))))))

(define (update-buttons uidat numruns numtests)
  (let* ((runs        (if (> (length (d:alldat-allruns *alldat*)) numruns)
			  (take-right (d:alldat-allruns *alldat*) numruns)
			  (pad-list (d:alldat-allruns *alldat*) numruns)))
	 (lftcol      (dboard:uidat-get-lftcol uidat))
	 (tableheader (dboard:uidat-get-header uidat))
	 (table       (dboard:uidat-get-runsvec uidat))
	 (coln        0))
    (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)))
	     (if (not (and (d:alldat-hide-empty-runs *alldat*)
			   (null? testnames)))
		 (for-each (lambda (testname)
			     (if (not (member testname *alltestnamelst*))
				 (begin
				   (set! *alltestnamelst* (append *alltestnamelst* (list testname))))))
			   testnames)))))
     runs)

    (set! *alltestnamelst* (collapse-rows *alltestnamelst*)) ;;; argh. please clean up this sillyness
    (set! *alltestnamelst* (let ((xl (if (> (length *alltestnamelst*) (d:alldat-start-test-offset *alldat*))
					 (drop *alltestnamelst* (d:alldat-start-test-offset *alldat*))
					 '())))
			     (append xl (make-list (- (d:alldat-num-tests *alldat*) (length xl)) ""))))
    (update-labels uidat)
    (for-each
     (lambda (rundat)
       (if (not rundat) ;; handle padded runs
	   ;;           ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration
	   (set! rundat (vector (make-vector 20 #f) '() (map (lambda (x) "") (d:alldat-keys *alldat*)))));; 3)))
       (let* ((run      (vector-ref rundat 0))
	      (testsdat (vector-ref rundat 1))
	      (key-val-dat (vector-ref rundat 2))
	      (run-id   (db:get-value-by-header run (d:alldat-header *alldat*) "id"))
	      (key-vals (append key-val-dat
				(list (let ((x (db:get-value-by-header run (d:alldat-header *alldat*) "runname")))
					(if x x "")))))
	      (run-key  (string-intersperse key-vals "\n")))
	 
	 ;; fill in the run header key values
	 (let ((rown      0)
	       (headercol (vector-ref tableheader coln)))
	   (for-each (lambda (kval)
		       (let* ((labl      (vector-ref headercol rown)))
			 (if (not (equal? kval (iup:attribute labl "TITLE")))
			     (iup:attribute-set! (vector-ref headercol rown) "TITLE" kval))
			 (set! rown (+ rown 1))))
		     key-vals))
	 
	 ;; For this run now fill in the buttons for each test
	 (let ((rown 0)
	       (columndat  (vector-ref table coln)))
	   (for-each
	    (lambda (testname)
	      (let ((buttondat  (hash-table-ref/default (d:alldat-buttondat *alldat*) (mkstr coln rown) #f)))
		(if buttondat
		    (let* ((test       (let ((matching (filter 
							(lambda (x)(equal? (test:test-get-fullname x) testname))
							testsdat)))
					 (if (null? matching)
					     (vector -1 -1 "" "" "" 0 "" "" 0 "" "" "" 0 "" "")
					     (car matching))))

	    *alltestnamelst*))
	 (set! coln (+ coln 1))))
     runs)))

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

(define (set-bg-on-filter)
  (let ((search-changed (not (null? (filter (lambda (key)
					      (not (equal? (hash-table-ref (d:alldat-searchpatts *alldat*) key) "%")))
					    (hash-table-keys (d:alldat-searchpatts *alldat*))))))
	(state-changed  (not (null? (hash-table-keys (d:alldat-state-ignore-hash *alldat*)))))
	(status-changed (not (null? (hash-table-keys (d:alldat-status-ignore-hash *alldat*))))))
    (iup:attribute-set! (d:alldat-hide-not-hide-tabs *alldat*) "BGCOLOR"
			(if (or search-changed
				state-changed
				status-changed)
			    "190 180 190"
			    "190 190 190"
			    ))
    (d:alldat-filters-changed-set! *alldat* #t)))

(define (update-search x val)
  (hash-table-set! (d:alldat-searchpatts *alldat*) x val)
  (d:alldat-filters-changed-set! *alldat* #t)
  (set-bg-on-filter))

(define (mark-for-update)
  (d:alldat-filters-changed-set! *alldat* #t)
  (d:alldat-last-db-update-set! *alldat* 0))

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

;; target populating logic
;;  

	  (if (not (null? values))
	      (let ((newval (car values)))
		(iup:attribute-set! lb "VALUE" newval)
		newval))))))

(define (dashboard:update-target-selector key-lbs #!key (action-proc #f))
  (let* ((runconf-targs (common:get-runconfig-targets))
	 (db-target-dat (if (d:alldat-useserver *alldat*) 
			    (rmt:get-targets)
			    (db:get-targets (d:alldat-dblocal *alldat*))))
	 (header        (vector-ref db-target-dat 0))
	 (db-targets    (vector-ref db-target-dat 1))
	 (all-targets   (append db-targets
				(map (lambda (x)
				       (list->vector
					(take (append (string-split x "/")
						      (make-list (length header) "na"))

			      (if (eq? tstate 0)
				  (hash-table-delete! alltgls item)
				  (hash-table-set! alltgls item #t))
			      (let ((all (hash-table-keys alltgls)))
				(proc all)))))
		items))))

;; Extract the various bits of data from data and create the command line equivalent that will be displayed
;;
(define (dashboard:update-run-command data)
  (let* ((cmd-tb       (dboard:data-command-tb data))
	 (cmd          (dboard:data-command    data))
	 (test-patt    (let ((tp (dboard:data-test-patts data)))
			 (if (equal? tp "") "%" tp)))
	 (states       (dboard:data-states     data))
	 (statuses     (dboard:data-statuses   data))
	 (target       (let ((targ-list (dboard:data-target     data)))
			 (if targ-list (string-intersperse targ-list "/") "no-target-selected")))
	 (run-name     (dboard:data-run-name   data))
	 (states-str   (if (or (not states)
			       (null? states))
			   ""
			   (conc " -state "  (string-intersperse states ","))))
	 (statuses-str (if (or (not statuses)
			       (null? statuses))
			   ""

;;======================================================================
;; R U N   C O N T R O L S
;;======================================================================
;;
;; A gui for launching tests
;;

(define (dashboard:run-controls alldat)
  (let* ((data          (make-vector 25 #f))
	 (targets       (make-hash-table))
	 (test-records  (make-hash-table))
	 (all-tests-registry (tests:get-all)) ;; (tests:get-valid-tests *toppath* '()))
	 (test-names    (hash-table-keys all-tests-registry))
	 (sorted-testnames #f)
	 (action        "-run")
	 (cmdln         "")
	 (runlogs       (make-hash-table))
	 (key-listboxes #f)
	 ;; (updater-for-runs #f)
	 (update-keyvals (lambda ()
			   (let ((targ (map (lambda (x)
					      (iup:attribute x "VALUE"))
					    (car (dashboard:update-target-selector key-listboxes))))
				 (curr-runname (dboard:data-run-name data)))
			     (dboard:data-target-set! data targ)
			     (if (dboard:data-updater-for-runs data)
				 ((dboard:data-updater-for-runs data)))
			     (if (or (not (equal? curr-runname (dboard:data-run-name data)))
				     (equal? (dboard:data-run-name data) ""))
				 (dboard:data-run-name-set! data curr-runname))
			     (dashboard:update-run-command data))))
	 (tests-draw-state (make-hash-table)) ;; use for keeping state of the test canvas
	 (test-patterns-textbox  #f))
    (hash-table-set! tests-draw-state 'first-time #t)
    ;; (hash-table-set! tests-draw-state 'scalef 1)
    (tests:get-full-data test-names test-records '() all-tests-registry)
    (set! sorted-testnames (tests:sort-by-priority-and-waiton test-records))
    
    ;; refer to (d:alldat-keys *alldat*), (d:alldat-dbkeys *alldat*) for keys
    (iup:vbox
     (dcommon:command-execution-control data)
     (iup:split
      #:orientation "VERTICAL" ;; "HORIZONTAL"
      #:value 200
;; 
;;       (iup:split
;;        #:value 300

       ;; Target, testpatt, state and status input boxes
       ;;
       (iup:vbox
	;; Command to run, placed over the top of the canvas
	(dcommon:command-action-selector data)
	(dcommon:command-runname-selector alldat data)
	(dcommon:command-testname-selector alldat data update-keyvals key-listboxes))
       
       (dcommon:command-tests-tasks-canvas data test-records sorted-testnames tests-draw-state))
       
 ;;(iup:frame
 ;; #:title "Logs" ;; To be replaced with tabs
 ;; (let ((logs-tb (iup:textbox #:expand "YES"
 ;;				   #:multiline "YES")))
 ;;	 (dboard:data-logs-textbox-set! data logs-tb)
 ;;	 logs-tb))
      )))

;;======================================================================
;; R U N   C O N T R O L S
;;======================================================================
;;
;; A gui for launching tests
;;
(define (dashboard:run-times alldat)
  (let* ((data          (make-vector 25 #f))
	 (targets       (make-hash-table))
	 (test-records  (make-hash-table))
	 (all-tests-registry (tests:get-all)) ;; (tests:get-valid-tests *toppath* '()))
	 (test-names    (hash-table-keys all-tests-registry))
	 (sorted-testnames #f)
	 (action        "-run")
	 (cmdln         "")
	 (runlogs       (make-hash-table))
	 (key-listboxes #f)
	 (updater-for-runs #f)
	 (update-keyvals (lambda ()
			   (let ((targ (map (lambda (x)
					      (iup:attribute x "VALUE"))
					    (car (dashboard:update-target-selector key-listboxes))))
				 (curr-runname (dboard:data-run-name data)))
			     (dboard:data-target-set! data targ)
			     (if updater-for-runs (updater-for-runs))
			     (if (or (not (equal? curr-runname (dboard:data-run-name data)))
				     (equal? (dboard:data-run-name data) ""))
				 (dboard:data-run-name-set! data curr-runname))
			     (dashboard:update-run-command data))))
	 (tests-draw-state (make-hash-table)) ;; use for keeping state of the test canvas
	 (test-patterns-textbox  #f))
    (hash-table-set! tests-draw-state 'first-time #t)
    ;; (hash-table-set! tests-draw-state 'scalef 1)
    (tests:get-full-data test-names test-records '() all-tests-registry)
    (set! sorted-testnames (tests:sort-by-priority-and-waiton test-records))
    
    ;; refer to (d:alldat-keys *alldat*), (d:alldat-dbkeys *alldat*) for keys
    (iup:vbox
     (dcommon:command-execution-control data)
     (iup:split
      #:orientation "VERTICAL" ;; "HORIZONTAL"
      #:value 200
      ;; (iup:split
      ;;  #:value 300

       ;; Target, testpatt, state and status input boxes
       ;;
       (iup:vbox
	;; Command to run, placed over the top of the canvas
	(dcommon:command-action-selector data)
	(dcommon:command-runname-selector alldat data)
	(dcommon:command-testname-selector alldat data update-keyvals key-listboxes))
       
       (dcommon:command-tests-tasks-canvas data test-records sorted-testnames tests-draw-state))
       
;; (iup:frame
;;  #:title "Logs" ;; To be replaced with tabs
;;  (let ((logs-tb (iup:textbox #:expand "YES"
;; 				   #:multiline "YES")))
;; 	 (dboard:data-logs-textbox-set! data logs-tb)
;; 	 logs-tb))
      )))

;;======================================================================
;; S U M M A R Y 
;;======================================================================
;;
;; General info about the run(s) and megatest area
(define (dashboard:summary data)
  (let* ((db               (d:alldat-dblocal data))
	 (rawconfig        (read-config (conc *toppath* "/megatest.config") #f #f))) ;; changed to #f since I want #{} to be expanded by [system ...] to NOT be expanded. WAS: 'return-string)))
    (iup:vbox
     (iup:split
      #:value 500
      (iup:frame 
       #:title "General Info"
       (iup:vbox
	(iup:hbox

       (iup:vbox
	(dcommon:section-matrix rawconfig "server" "Varname" "Value")
	;; (iup:frame
	;; #:title "Disks Areas"
	(dcommon:section-matrix rawconfig "disks" "Disk area" "Path"))))
     (iup:frame
      #:title "Run statistics"
      (dcommon:run-stats db)))))

;;======================================================================
;; R U N
;;======================================================================
;;
;; display and manage a single run at a time

(define (tree-path->run-id data path)
  (if (not (null? path))
      (hash-table-ref/default (d:data-path-run-ids data) path #f)
      #f))

(define dashboard:update-run-summary-tab #f)
(define dashboard:update-new-view-tab #f)

(define (dboard:get-tests-dat data run-id last-update)
  (let ((tdat (if run-id
		  (if (d:alldat-useserver data)
		      (rmt:get-tests-for-run run-id 
					     (hash-table-ref/default (d:alldat-searchpatts data) "test-name" "%/%")
					     (hash-table-keys (d:alldat-state-ignore-hash data)) ;; '()
					     (hash-table-keys (d:alldat-status-ignore-hash data)) ;; '()
					     #f #f
					     (d:alldat-hide-not-hide data)
					     #f #f
					     "id,testname,item_path,state,status"
					     (if (d:alldat-filters-changed data)
						 0
						 last-update)
					     *dashboard-mode*) ;; get 'em all
		      (db:get-tests-for-run db run-id 
					    (hash-table-ref/default (d:alldat-searchpatts data) "test-name" "%/%")
					    (hash-table-keys (d:alldat-state-ignore-hash data)) ;; '()
					    (hash-table-keys (d:alldat-status-ignore-hash data)) ;; '()
					    #f #f
					    (d:alldat-hide-not-hide data)
					    #f #f
					    "id,testname,item_path,state,status"
					    (if (d:alldat-filters-changed data)
						0
						last-update)
					    *dashboard-mode*))
		  '()))) ;; get 'em all
    (debug:print 0 *default-log-port* "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id)
    (sort tdat (lambda (a b)
		 (let* ((aval (vector-ref a 2))
			(bval (vector-ref b 2))
			(anum (string->number aval))
			(bnum (string->number bval)))
		   (if (and anum bnum)
		       (< anum bnum)
		       (string<= aval bval)))))))

;; This is the Run Summary tab
;; 
(define (dashboard:one-run db data ddata)
  (let* ((tb      (iup:treebox
		   #:value 0
		   #:name "Runs"
		   #:expand "YES"
		   #:addexpanded "NO"
		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((run-path (tree:node->path obj id))
			    (run-id   (tree-path->run-id ddata (cdr run-path))))
		       (if (number? run-id)
			   (begin
			     (d:data-curr-run-id-set! ddata run-id)
			     (dashboard:update-run-summary-tab))
			   (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id)))
		     ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
		     )))
	 (cell-lookup (make-hash-table))
	 (run-matrix (iup:matrix
		      #:expand "YES"
		      #:click-cb
		      (lambda (obj lin col status)
			(let* ((toolpath (car (argv)))
			       (key      (conc lin ":" col))
			       (test-id  (hash-table-ref/default cell-lookup key -1))
			       (cmd      (conc toolpath " -test " (d:data-curr-run-id ddata) "," test-id "&")))
			  (system cmd)))))
	 (updater  (lambda ()
		     (let* ((runs-dat     (if (d:alldat-useserver data)
					      (rmt:get-runs-by-patt (d:alldat-keys data) "%" #f #f #f #f)
					      (db:get-runs-by-patt db (d:alldat-keys data) "%" #f #f #f #f)))
			    (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
			    (run-id       (d:data-curr-run-id ddata))
			    (last-update  0) ;; fix me
			    (tests-dat    (dboard:get-tests-dat data run-id last-update))
			    (tests-mindat (dcommon:minimize-test-data tests-dat))
			    (indices      (common:sparse-list-generate-index tests-mindat)) ;;  proc: set-cell))
			    (row-indices  (cadr indices))
			    (col-indices  (car indices))
			    (max-row      (if (null? row-indices) 1 (common:max (map cadr row-indices))))
			    (max-col      (if (null? col-indices) 1 (common:max (map cadr col-indices))))
			    (max-visible  (max (- (d:alldat-num-tests data) 15) 3)) ;; (d:alldat-num-tests data) is proportional to the size of the window
			    (numrows      1)
			    (numcols      1)
			    (changed      #f)
			    (runs-hash    (let ((ht (make-hash-table)))
					    (for-each (lambda (run)
							(hash-table-set! ht (db:get-value-by-header run runs-header "id") run))
						      (vector-ref runs-dat 1))
					    ht))
			    (run-ids      (sort (filter number? (hash-table-keys runs-hash))
						(lambda (a b)
						  (let* ((record-a (hash-table-ref runs-hash a))
							 (record-b (hash-table-ref runs-hash b))
							 (time-a   (db:get-value-by-header record-a runs-header "event_time"))
							 (time-b   (db:get-value-by-header record-b runs-header "event_time")))
						    (< time-a time-b))))))
		       
		       (d:alldat-filters-changed-set! data #f)
		       ;; (iup:attribute-set! tb "VALUE" "0")
		       ;; (iup:attribute-set! tb "NAME" "Runs")
		       ;; Update the runs tree
		       (for-each (lambda (run-id)
				   (let* ((run-record (hash-table-ref/default runs-hash run-id #f))
					  (key-vals   (map (lambda (key)(db:get-value-by-header run-record runs-header key))
							   (d:alldat-keys data)))
					  (run-name   (db:get-value-by-header run-record runs-header "runname"))
					  (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
					  (run-path   (append key-vals (list run-name)))
					  (existing   (tree:find-node tb run-path)))
				     (if (not (hash-table-ref/default (d:data-path-run-ids ddata) run-path #f))
					 (begin
					   (hash-table-set! (d:data-run-keys ddata) run-id run-path)
					   ;; (iup:attribute-set! (dboard:data-runs-matrix data)
					   ;;    		 (conc rownum ":" colnum) col-name)
					   ;; (hash-table-set! runid-to-col run-id (list colnum run-record))
					   ;; Here we update the tests treebox and tree keys
					   (tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
							  userdata: (conc "run-id: " run-id))
					   (hash-table-set! (d:data-path-run-ids ddata) run-path run-id)
					   ;; (set! colnum (+ colnum 1))
					   ))))
				 run-ids)
		       (iup:attribute-set! run-matrix "CLEARVALUE" "ALL") ;; NOTE: Was CONTENTS
		       (iup:attribute-set! run-matrix "CLEARATTRIB" "CONTENTS")
		       (iup:attribute-set! run-matrix "RESIZEMATRIX" "YES")
		       (iup:attribute-set! run-matrix "NUMCOL" max-col )

					   (set! changed #t)
					   (iup:attribute-set! run-matrix key name)
					   (iup:attribute-set! run-matrix "FITTOTEXT" (conc "C" num))))))
				 col-indices)
		       (if changed (iup:attribute-set! run-matrix "REDRAW" "ALL"))))))
    
    (set! dashboard:update-run-summary-tab updater)
    (d:data-runs-tree-set! ddata tb)
    (iup:split
     tb
     run-matrix)))

;; This is the New View tab
;; 
(define (dashboard:new-view db data ddata)
  (let* ((tb      (iup:treebox
		   #:value 0
		   #:name "Runs"
		   #:expand "YES"
		   #:addexpanded "NO"
		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((run-path (tree:node->path obj id))
			    (run-id   (tree-path->run-id ddata (cdr run-path))))
		       (if (number? run-id)
			   (begin
			     (d:data-curr-run-id-set! ddata run-id)
			     (dashboard:update-new-view-tab))
			   (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id)))
		     ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
		     )))
	 (cell-lookup (make-hash-table))
	 (run-matrix (iup:matrix
		      #:expand "YES"
		      #:click-cb
		      (lambda (obj lin col status)
			(let* ((toolpath (car (argv)))
			       (key      (conc lin ":" col))
			       (test-id  (hash-table-ref/default cell-lookup key -1))
			       (cmd      (conc toolpath " -test " (d:data-curr-run-id ddata) "," test-id "&")))
			  (system cmd)))))
	 (updater  (lambda ()
		     (let* ((runs-dat     (if (d:alldat-useserver data)
					      (rmt:get-runs-by-patt (d:alldat-keys data) "%" #f #f #f #f)
					      (db:get-runs-by-patt db (d:alldat-keys data) "%" #f #f #f #f)))
			    (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
			    (run-id       (d:data-curr-run-id ddata))
			    (last-update  0) ;; fix me
			    (tests-dat    (dboard:get-tests-dat data run-id last-update))
			    (tests-mindat (dcommon:minimize-test-data tests-dat))
			    (indices      (common:sparse-list-generate-index tests-mindat)) ;;  proc: set-cell))
			    (row-indices  (cadr indices))
			    (col-indices  (car indices))
			    (max-row      (if (null? row-indices) 1 (common:max (map cadr row-indices))))
			    (max-col      (if (null? col-indices) 1 (common:max (map cadr col-indices))))
			    (max-visible  (max (- (d:alldat-num-tests data) 15) 3)) ;; (d:alldat-num-tests data) is proportional to the size of the window
			    (numrows      1)
			    (numcols      1)
			    (changed      #f)
			    (runs-hash    (let ((ht (make-hash-table)))
					    (for-each (lambda (run)
							(hash-table-set! ht (db:get-value-by-header run runs-header "id") run))
						      (vector-ref runs-dat 1))

		       
		       ;; (iup:attribute-set! tb "VALUE" "0")
		       ;; (iup:attribute-set! tb "NAME" "Runs")
		       ;; Update the runs tree
		       (for-each (lambda (run-id)
				   (let* ((run-record (hash-table-ref/default runs-hash run-id #f))
					  (key-vals   (map (lambda (key)(db:get-value-by-header run-record runs-header key))
							   (d:alldat-keys data)))
					  (run-name   (db:get-value-by-header run-record runs-header "runname"))
					  (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
					  (run-path   (append key-vals (list run-name)))
					  (existing   (tree:find-node tb run-path)))
				     (if (not (hash-table-ref/default (d:data-path-run-ids ddata) run-path #f))
					 (begin
					   (hash-table-set! (d:data-run-keys ddata) run-id run-path)
					   ;; (iup:attribute-set! (dboard:data-runs-matrix data)
					   ;;    		 (conc rownum ":" colnum) col-name)
					   ;; (hash-table-set! runid-to-col run-id (list colnum run-record))
					   ;; Here we update the tests treebox and tree keys
					   (tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
							  userdata: (conc "run-id: " run-id))
					   (hash-table-set! (d:data-path-run-ids ddata) run-path run-id)
					   ;; (set! colnum (+ colnum 1))
					   ))))
				 run-ids)
		       (iup:attribute-set! run-matrix "CLEARVALUE" "ALL") ;; NOTE: Was CONTENTS
		       (iup:attribute-set! run-matrix "CLEARATTRIB" "CONTENTS")
		       (iup:attribute-set! run-matrix "RESIZEMATRIX" "YES")
		       (iup:attribute-set! run-matrix "NUMCOL" max-col )

					   (set! changed #t)
					   (iup:attribute-set! run-matrix key name)
					   (iup:attribute-set! run-matrix "FITTOTEXT" (conc "C" num))))))
				 col-indices)
		       (if changed (iup:attribute-set! run-matrix "REDRAW" "ALL"))))))
    
    (set! dashboard:update-new-view-tab updater)
    (d:data-runs-tree-set! ddata tb)
    (iup:split
     tb
     run-matrix)))

;;======================================================================
;; R U N S 
;;======================================================================

(define (dboard:make-controls data)
	  (iup:hbox
	   (iup:vbox
	    (iup:frame 
	     #:title "filter test and items"
	     (iup:hbox
	      (iup:vbox
	       (iup:textbox #:size "120x15" #:fontsize "10" #:value "%"
			    #:action (lambda (obj unk val)
				       (mark-for-update)
				       (update-search "test-name" val)))
	       (iup:hbox
		(iup:button "Quit"      #:action (lambda (obj)
						   ;; (if (d:alldat-dblocal data) (db:close-all (d:alldat-dblocal data)))
						   (exit)))
		(iup:button "Refresh"   #:action (lambda (obj)
						   (mark-for-update)))
		(iup:button "Collapse"  #:action (lambda (obj)
						   (let ((myname (iup:attribute obj "TITLE")))
						     (if (equal? myname "Collapse")
							 (begin
							   (for-each (lambda (tname)
								       (hash-table-set! *collapsed* tname #t))
								     (d:alldat-item-test-names data))
							   (iup:attribute-set! obj "TITLE" "Expand"))
							 (begin
							   (for-each (lambda (tname)
								       (hash-table-delete! *collapsed* tname))
								     (hash-table-keys *collapsed*))
							   (iup:attribute-set! obj "TITLE" "Collapse"))))
						   (mark-for-update))))
	       )
	      (iup:vbox
	       ;; (iup:button "Sort -t"   #:action (lambda (obj)
	       ;;   				 (next-sort-option)
	       ;;   				 (iup:attribute-set! obj "TITLE" (vector-ref (vector-ref *tests-sort-options* *tests-sort-reverse*) 0))
	       ;;   				 (mark-for-update)))
	       
	       (let* ((hide #f)
		      (show #f)
		      (hide-empty #f)
		      (sel-color    "180 100 100")
		      (nonsel-color "170 170 170")
		      (cmds-list '("+testname" "-testname" "+event_time" "-event_time" "+statestatus" "-statestatus"))
		      (sort-lb    (iup:listbox #:expand "HORIZONTAL"
					       #:dropdown "YES"
					       #:action (lambda (obj val index lbstate)
							  (set! *tests-sort-reverse* index)
							  (mark-for-update))))
		      (default-cmd (car (list-ref *tests-sort-type-index* *tests-sort-reverse*))))
		 (iuplistbox-fill-list sort-lb cmds-list selected-item: default-cmd)
		 
		 (set! hide-empty (iup:button "HideEmpty"
					      #:expand "YES"
					      #:action (lambda (obj)
							 (d:alldat-hide-empty-runs-set! data (not (d:alldat-hide-empty-runs data)))
							 (iup:attribute-set! obj "TITLE" (if (d:alldat-hide-empty-runs data) "+HideE" "-HideE"))
							 (mark-for-update))))
		 (set! hide (iup:button "Hide"
					#:expand "YES"
					#:action (lambda (obj)
						   (d:alldat-hide-not-hide-set! data #t) ;; (not (d:alldat-hide-not-hide data)))
						   ;; (iup:attribute-set! obj "TITLE" (if (d:alldat-hide-not-hide data) "HideTests" "NotHide"))
						   (iup:attribute-set! hide "BGCOLOR" sel-color)
						   (iup:attribute-set! show "BGCOLOR" nonsel-color)
						   (mark-for-update))))
		 (set! show (iup:button "Show"
					#:expand "YES"
					#:action (lambda (obj)
						   (d:alldat-hide-not-hide-set! data #f) ;; (not (d:alldat-hide-not-hide data)))
						   (iup:attribute-set! show "BGCOLOR" sel-color)
						   (iup:attribute-set! hide "BGCOLOR" nonsel-color)
						   (mark-for-update))))
		 (iup:attribute-set! hide "BGCOLOR" sel-color)
		 (iup:attribute-set! show "BGCOLOR" nonsel-color)
		 ;; (d:alldat-hide-not-hide-button-set! data hideit) ;; never used, can eliminate ...
		 (iup:vbox
		  (iup:hbox hide show)
		  hide-empty sort-lb)))
	      )))
	   (iup:frame 
	    #:title "state/status filter"
	    (iup:vbox
	     (apply 
	      iup:hbox
	      (map (lambda (status)
		     (iup:toggle (conc status "  ")
				 #:action   (lambda (obj val)
					      (mark-for-update)
					      (if (eq? val 1)
						  (hash-table-set! (d:alldat-status-ignore-hash data) status #t)
						  (hash-table-delete! (d:alldat-status-ignore-hash data) status))
					      (set-bg-on-filter))))
		   (map cadr *common:std-statuses*))) ;; '("PASS" "FAIL" "WARN" "CHECK" "WAIVED" "STUCK/DEAD" "n/a" "SKIP")))
	     (apply 
	      iup:hbox
	      (map (lambda (state)
		     (iup:toggle (conc state "  ")
				 #:action   (lambda (obj val)
					      (mark-for-update)
					      (if (eq? val 1)
						  (hash-table-set! (d:alldat-state-ignore-hash data) state #t)
						  (hash-table-delete! (d:alldat-state-ignore-hash data) state))
					      (set-bg-on-filter))))
		   (map cadr *common:std-states*))) ;; '("RUNNING" "COMPLETED" "INCOMPLETE" "LAUNCHED" "NOT_STARTED" "KILLED" "DELETED")))
	     (iup:valuator #:valuechanged_cb (lambda (obj)
					       (let ((val (inexact->exact (round (/ (string->number (iup:attribute obj "VALUE")) 10))))
						     (oldmax   (string->number (iup:attribute obj "MAX")))
						     (maxruns  (d:alldat-tot-runs data)))
						 (d:alldat-start-run-offset-set! data val)
						 (mark-for-update)
						 (debug:print 6 *default-log-port* "(d:alldat-start-run-offset data) " (d:alldat-start-run-offset data) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
						 (iup:attribute-set! obj "MAX" (* maxruns 10))))
			   #:expand "HORIZONTAL"
			   #:max (* 10 (length (d:alldat-allruns data)))
			   #:min 0
			   #:step 0.01)))
					;(iup:button "inc rows" #:action (lambda (obj)(d:alldat-num-tests-set! data (+ (d:alldat-num-tests data) 1))))
					;(iup:button "dec rows" #:action (lambda (obj)(d:alldat-num-tests-set! data (if (> (d:alldat-num-tests data) 0)(- (d:alldat-num-tests data) 1) 0))))
	   ))

(define (dashboard:popup-menu buttndat run-id test-id target runname test-name testpatt)
  (iup:menu 
   (iup:menu-item
    "Run"
    (iup:menu              

	       (cmd (conc (if (string-search editor-rx editor)
			      (conc "xterm -e " editor)
			      editor)
			  " " tconfig " &")))
	  (system cmd))))
     ))))

(define (make-dashboard-buttons data nruns ntests keynames runs-sum-dat new-view-dat)

  (let* ((db      (d:alldat-dblocal data))





	 (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)
    (set! controls (dboard:make-controls data))
    
    ;; create the left most column for the run key names and the test names 
    (set! lftlst (list (iup:hbox
			(iup:label) ;; (iup:valuator)
			(apply iup:vbox 
			       (map (lambda (x)		
				      (let ((res (iup:hbox #:expand "HORIZONTAL"
							   (iup:label x #:size "x15" #:fontsize "10" #:expand "HORIZONTAL")
							   (iup:textbox #:size "x15" #:fontsize "10" #:value "%" #:expand "HORIZONTAL"
									#:action (lambda (obj unk val)
										   (mark-for-update)
										   (update-search x val))))))
					(set! i (+ i 1))
					res))
				    keynames)))))
    (let loop ((testnum  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  #:expand "HORIZONTAL"
						     (iup:valuator #:valuechanged_cb (lambda (obj)
										       (let ((val (string->number (iup:attribute obj "VALUE")))
											     (oldmax  (string->number (iup:attribute obj "MAX")))
											     (newmax  (* 10 (length *alltestnamelst*))))
											 (d:alldat-please-update-set! data #t)
											 (d:alldat-start-test-offset-set! *alldat* (inexact->exact (round (/ val 10))))
											 (debug:print 6 *default-log-port* "(d:alldat-start-test-offset *alldat*) " (d:alldat-start-test-offset *alldat*) " val: " val " newmax: " newmax " oldmax: " oldmax)
											 (if (< val 10)
											     (iup:attribute-set! obj "MAX" newmax))
											 ))
								   #:expand "VERTICAL" 
								   #:orientation "VERTICAL"
								   #:min 0
								   #:step 0.01)
						     (apply iup:vbox (reverse res)))))))
       (else
	(let ((labl  (iup:button "" 
				 #:flat "YES" 
				 #:alignment "ALEFT"
					; #:image img1
					; #:impress img2
				 #:size "x15"
				 #:expand "HORIZONTAL"
				 #:fontsize "10"
				 #:action (lambda (obj)
					    (mark-for-update)
					    (toggle-hide testnum))))) ;; (iup:attribute obj "TITLE"))))
	  (vector-set! lftcol testnum labl)
	  (loop (+ testnum 1)(cons labl res))))))
    ;; 
    (let loop ((runnum  0)
	       (keynum  0)
	       (keyvec  (make-vector nkeys))
	       (res    '()))

			    #:fontsize "10"
			    #:button-cb
			    (lambda (obj a pressed x y btn . rem)
			      ;; (print "pressed= " pressed " x= " x " y= " y " rem=" rem " btn=" btn " string? " (string? btn))
			      (if  (substring-index "3" btn)
				   (if (eq? pressed 1)
				       (let* ((toolpath (car (argv)))
					      (buttndat (hash-table-ref (d:alldat-buttondat *alldat*) button-key))
					      (test-id  (db:test-get-id (vector-ref buttndat 3)))
					      (run-id   (db:test-get-run_id (vector-ref buttndat 3)))
					      (run-info (rmt:get-run-info run-id))
					      (target   (rmt:get-target run-id))
					      (runname  (db:get-value-by-header (db:get-rows run-info)
										(db:get-header run-info) "runname"))
					      (test-name (db:test-get-testname (rmt:get-test-info-by-id run-id test-id)))

						   #:x 'mouse
						   #:y 'mouse
						   #:modal? "NO")
					 ;; (print "got here")
					 ))
				   (if (eq? pressed 0)
				       (let* ((toolpath (car (argv)))
					      (buttndat (hash-table-ref (d:alldat-buttondat *alldat*) button-key))
					      (test-id  (db:test-get-id (vector-ref buttndat 3)))
					      (run-id   (db:test-get-run_id (vector-ref buttndat 3)))
					      (cmd  (conc toolpath " -test " run-id "," test-id "&")))
					 (system cmd)))
				   )))))
	  (hash-table-set! (d:alldat-buttondat *alldat*) 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
			 ))
	     ;; (data (d:data-init (make-d:data)))
	     (tabs (iup:tabs
		    #:tabchangepos-cb (lambda (obj curr prev)
					(d:alldat-please-update-set! *alldat* #t)
					(d:alldat-curr-tab-num-set! *alldat* curr))
		    (dashboard:summary *alldat*)
		    runs-view
		    (dashboard:one-run db  data runs-sum-dat)
		    ;; (dashboard:new-view db data new-view-dat)
		    (dashboard:run-controls *alldat*)
		    (dashboard:run-times *alldat*)
		    )))
	;; (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 Summary")
	(iup:attribute-set! tabs "TABTITLE3" "Run Control")
	(iup:attribute-set! tabs "TABTITLE4" "Run Times")
	;; (iup:attribute-set! tabs "TABTITLE3" "New View")
	;; (iup:attribute-set! tabs "TABTITLE4" "Run Control")
	(iup:attribute-set! tabs "BGCOLOR" "190 190 190")

	(d:alldat-hide-not-hide-tabs-set! *alldat* tabs)






	(iup:vbox
	 tabs
	 controls))))
    (vector keycol lftcol header runsvec)))


(if (or (args:get-arg "-rows")
	(get-environment-variable "DASHBOARDROWS" ))
    (begin
      (d:alldat-num-tests-set! *alldat* (string->number
					 (or (args:get-arg "-rows")
					     (get-environment-variable "DASHBOARDROWS"))))
      (update-rundat *alldat* "%" (d:alldat-numruns *alldat*) "%/%" '()))
    (d:alldat-num-tests-set! *alldat* (min (max (update-rundat *alldat* "%" (d:alldat-numruns *alldat*) "%/%" '()) 8) 20)))

(define *tim* (iup:timer))
(define *ord* #f)
(iup:attribute-set! *tim* "TIME" 300)
(iup:attribute-set! *tim* "RUN" "YES")

;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
;;
(d:alldat-last-db-update-set! *alldat* (file-modification-time (d:alldat-dbfpath *alldat*))) ;; (conc *toppath* "/db/main.db")))
(define *last-recalc-ended-time* 0)

(define (dashboard:been-changed)
  (> (file-modification-time (d:alldat-dbfpath *alldat*)) (d:alldat-last-db-update *alldat*)))

(define (dashboard:set-db-update-time)
  (d:alldat-last-db-update-set! *alldat* (file-modification-time (d:alldat-dbfpath *alldat*))))

(define (dashboard:recalc modtime please-update-buttons last-db-update-time)
  (or please-update-buttons
      (and (> (current-milliseconds)(+ *last-recalc-ended-time* 150))
	   (> modtime last-db-update-time)
	   (> (current-seconds)(+ last-db-update-time 1)))))

(define *monitor-db-path* (conc (d:alldat-dbdir *alldat*) "/monitor.db"))
(define *last-monitor-update-time* 0)

;; Force creation of the db in case it isn't already there.
(tasks:open-db)

(define (dashboard:get-youngest-run-db-mod-time)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (apply max (map (lambda (filen)
		     (file-modification-time filen))
		   (glob (conc (d:alldat-dbdir *alldat*) "/*.db"))))))

(define (dashboard:run-update x)



  (let* ((modtime         (dashboard:get-youngest-run-db-mod-time)) ;; (file-modification-time (d:alldat-dbfpath *alldat*)))
	 (monitor-modtime (if (file-exists? *monitor-db-path*)
			      (file-modification-time *monitor-db-path*)
			      -1))
	 (run-update-time (current-seconds))

	 (recalc          (dashboard:recalc modtime (d:alldat-please-update *alldat*) (d:alldat-last-db-update *alldat*))))
    (if (and (eq? (d:alldat-curr-tab-num *alldat*) 0)
	     (or (> monitor-modtime *last-monitor-update-time*)
		 (> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case
	(begin
	  (set! *last-monitor-update-time* run-update-time) ;; monitor-modtime)
	  (if dashboard:update-servers-table (dashboard:update-servers-table))))
    (if recalc
	(begin	
	  (case (d:alldat-curr-tab-num *alldat*) 
	    ((0) 
	     (if dashboard:update-summary-tab (dashboard:update-summary-tab)))
	    ((1) ;; The runs table is active
	     (update-rundat *alldat* (hash-table-ref/default (d:alldat-searchpatts *alldat*) "runname" "%") (d:alldat-numruns *alldat*)
			    (hash-table-ref/default (d:alldat-searchpatts *alldat*) "test-name" "%/%")
			    ;; (hash-table-ref/default (d:alldat-searchpatts *alldat*) "item-name" "%")
			    (let ((res '()))
			      (for-each (lambda (key)
					  (if (not (equal? key "runname"))
					      (let ((val (hash-table-ref/default (d:alldat-searchpatts *alldat*) key #f)))
						(if val (set! res (cons (list key val) res))))))
					(d:alldat-dbkeys *alldat*))
			      res))
	     (update-buttons uidat (d:alldat-numruns *alldat*) (d:alldat-num-tests *alldat*)))
	    ((2)
	     (dashboard:update-run-summary-tab))
	    ((3)
	     (dashboard:update-new-view-tab))
	    (else
	     (let ((updater (hash-table-ref/default (d:alldat-updaters *alldat*)
						    (d:alldat-curr-tab-num *alldat*) #f)))
	       (if updater (updater)))))
	  (d:alldat-please-update-set! *alldat* #f)
	  (d:alldat-last-db-update-set! *alldat* modtime)
	  (set! *last-recalc-ended-time* (current-milliseconds))))))

;;======================================================================
;; The heavy lifting starts here
;;======================================================================

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define (main)
  (common:exit-on-version-changed)
  (let* ((runs-sum-dat (d:data-init (make-d:data))) ;; data for run-summary tab
	 (new-view-dat (d:data-init (make-d:data)))
	 (data         *alldat*))
    (cond 
     ((args:get-arg "-run")
      (let ((runid (string->number (args:get-arg "-run"))))
	(if runid
	    (begin
	      (lambda (x)
		(on-exit std-exit-procedure)
		(examine-run (d:alldat-dblocal data) runid)))
	    (begin
	      (print "ERROR: runid is not a number " (args:get-arg "-run"))
	      (exit 1)))))
     ((args:get-arg "-test") ;; run-id,test-id
      (let* ((dat     (let ((d (map string->number (string-split (args:get-arg "-test") ","))))
			(if (> (length d) 1)
			    d
			    (list #f #f))))
	     (run-id  (car dat))
	     (test-id (cadr dat)))
	(if (and (number? run-id)
		 (number? test-id)
		 (>= test-id 0))
	    (examine-test run-id test-id)
	    (begin
	      (debug:print 3 *default-log-port* "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test"))
	      (exit 1)))))
     ((args:get-arg "-xterm") ;; run-id,test-id
      (let* ((dat     (let ((d (map string->number (string-split (args:get-arg "-xterm") ","))))
			(if (> (length d) 1)
			    d
			    (list #f #f))))
	     (run-id  (car dat))
	     (test-id (cadr dat)))
	(if (and (number? run-id)
		 (number? test-id)
		 (>= test-id 0))
	    (dcommon:examine-xterm run-id test-id)
	    (begin
	      (debug:print 3 "INFO: tried to open xterm with invalid run-id,test-id. " (args:get-arg "-xterm"))
	      (exit 1)))))
     ((args:get-arg "-guimonitor")
      (gui-monitor (d:alldat-dblocal data)))
     (else
      (set! uidat (make-dashboard-buttons data ;; (d:alldat-dblocal data)
					  (d:alldat-numruns data)
					  (d:alldat-num-tests data)
					  (d:alldat-dbkeys data)
					  runs-sum-dat new-view-dat))
      (iup:callback-set! *tim*
			 "ACTION_CB"
			 (lambda (x)
			   (let ((update-is-running #f))
			     (mutex-lock! (d:alldat-update-mutex data))
			     (set! update-is-running (d:alldat-updating data))
			     (if (not update-is-running)
				 (d:alldat-updating-set! data #t))
			     (mutex-unlock! (d:alldat-update-mutex data))
			     (if (not update-is-running)
				 (begin
				   (dashboard:run-update x)
				   (mutex-lock! (d:alldat-update-mutex data))
				   (d:alldat-updating-set! data #f)
				   (mutex-unlock! (d:alldat-update-mutex data)))))

			   1))))
    
    (let ((th1 (make-thread (lambda ()
			      (thread-sleep! 1)
			      (d:alldat-please-update-set! data #t)
			      (dashboard:run-update 1)) "update buttons once"))

	  (th2 (make-thread iup:main-loop "Main loop")))
      (thread-start! th1)
      (thread-start! th2)
      (thread-join! th2))))

(main)

(define dashboard:update-summary-tab #f)
(define dashboard:update-servers-table #f)

;;======================================================================
;; C O M M O N   D A T A   S T R U C T U R E
;;======================================================================
;; 
;; A single data structure for all the data used in a dashboard.
;; Share this structure between newdashboard and dashboard with the 
;; intent of converging on a single app.
;;
(define *data* (make-vector 25 #f))
(define (dboard:data-runs          vec)    (vector-ref  vec 0))
(define (dboard:data-tests         vec)    (vector-ref  vec 1))
(define (dboard:data-runs-matrix   vec)    (vector-ref  vec 2))
(define (dboard:data-tests-tree    vec)    (vector-ref  vec 3))
(define (dboard:data-run-keys      vec)    (vector-ref  vec 4))
(define (dboard:data-curr-test-ids vec)    (vector-ref  vec 5))
;; (define (dboard:data-test-details  vec)    (vector-ref  vec 6))
(define (dboard:data-path-test-ids vec)    (vector-ref  vec 7))
(define (dboard:data-updaters      vec)    (vector-ref  vec 8))
(define (dboard:data-path-run-ids  vec)    (vector-ref  vec 9))
(define (dboard:data-curr-run-id   vec)    (vector-ref  vec 10))
(define (dboard:data-runs-tree     vec)    (vector-ref  vec 11))
;; For test-patts convert #f to ""
(define (dboard:data-test-patts    vec)    
  (let ((val (vector-ref  vec 12)))(if val val "")))
(define (dboard:data-states        vec)    (vector-ref vec 13))
(define (dboard:data-statuses      vec)    (vector-ref vec 14))
(define (dboard:data-logs-textbox  vec val)(vector-ref vec 15))
(define (dboard:data-command       vec)    (vector-ref vec 16))
(define (dboard:data-command-tb    vec)    (vector-ref vec 17))
(define (dboard:data-target        vec)    (vector-ref vec 18))
(define (dboard:data-target-string vec)
  (let ((targ (dboard:data-target vec)))
    (if (list? targ)(string-intersperse targ "/") "no-target-specified")))
(define (dboard:data-run-name      vec)    (vector-ref vec 19))
(define (dboard:data-runs-listbox  vec)    (vector-ref vec 20))
(define (dboard:data-updater-for-runs vec) (vector-ref vec 21))

(defstruct d:data runs tests runs-matrix tests-tree run-keys
  curr-test-ids updaters path-run-ids curr-run-id runs-tree test-patts
  states statuses logs-textbox command command-tb target run-name
  runs-listbox)

(define (dboard:data-runs-set!          vec val)(vector-set! vec 0 val))
(define (dboard:data-tests-set!         vec val)(vector-set! vec 1 val))
(define (dboard:data-runs-matrix-set!   vec val)(vector-set! vec 2 val))
(define (dboard:data-tests-tree-set!    vec val)(vector-set! vec 3 val))
(define (dboard:data-run-keys-set!      vec val)(vector-set! vec 4 val))
(define (dboard:data-curr-test-ids-set! vec val)(vector-set! vec 5 val))
;; (define (dboard:data-test-details-set!  vec val)(vector-set! vec 6 val))
(define (dboard:data-path-test-ids-set! vec val)(vector-set! vec 7 val))
(define (dboard:data-updaters-set!      vec val)(vector-set! vec 8 val))
(define (dboard:data-path-run-ids-set!  vec val)(vector-set! vec 9 val))
(define (dboard:data-curr-run-id-set!   vec val)(vector-set! vec 10 val))
(define (dboard:data-runs-tree-set!     vec val)(vector-set! vec 11 val))
;; For test-patts convert "" to #f 
(define (dboard:data-test-patts-set!    vec val)
  (vector-set! vec 12 (if (equal? val "") #f val)))
(define (dboard:data-states-set!        vec val)(vector-set! vec 13 val))
(define (dboard:data-statuses-set!      vec val)(vector-set! vec 14 val))
(define (dboard:data-logs-textbox-set!  vec val)(vector-set! vec 15 val))
(define (dboard:data-command-set!       vec val)(vector-set! vec 16 val))
(define (dboard:data-command-tb-set!    vec val)(vector-set! vec 17 val))
(define (dboard:data-target-set!        vec val)(vector-set! vec 18 val))
(define (dboard:data-run-name-set!      vec val)(vector-set! vec 19 val))
(define (dboard:data-runs-listbox-set!  vec val)(vector-set! vec 20 val))
(define (dboard:data-updater-for-runs-set! vec val)(vector-set! vec 21 val))

(dboard:data-run-keys-set! *data* (make-hash-table))

;; List of test ids being viewed in various panels
(dboard:data-curr-test-ids-set! *data* (make-hash-table))

;; Look up test-ids by (key1 key2 ... testname [itempath])
(dboard:data-path-test-ids-set! *data* (make-hash-table))

;; Look up run-ids by ??
(dboard:data-path-run-ids-set! *data* (make-hash-table))

(define (d:data-init dat)
  (d:data-run-keys-set!      dat (make-hash-table))
  (d:data-curr-test-ids-set! dat (make-hash-table))
  (d:data-path-run-ids-set!  dat (make-hash-table))
  dat)

;;======================================================================
;; D O T F I L E
;;======================================================================

(define (dcommon:write-dotfile fname dat)
  (with-output-to-file fname

  (let* (;; count and offset => #f so not used
	 ;; the synchash calls modify the "data" hash
	 (get-runs-sig    (conc (client:get-signature) " get-runs"))
	 (get-tests-sig   (conc (client:get-signature) " get-tests"))
	 (get-details-sig (conc (client:get-signature) " get-test-details"))

	 ;; test-ids to get and display are indexed on window-id in curr-test-ids hash
	 (test-ids        (hash-table-values (dboard:data-curr-test-ids *data*)))
	 ;; run-id is #f in next line to send the query to server 0
 	 (run-changes     (synchash:client-get 'db:get-runs get-runs-sig (length keypatts) data #f runname #f #f keypatts))
	 (tests-detail-changes (if (not (null? test-ids))
				   (synchash:client-get 'db:get-test-info-by-ids get-details-sig 0  data #f test-ids)
				   '()))

	 ;; Now can calculate the run-ids

    (for-each (lambda (run-id)
		(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
		       (key-vals   (map (lambda (key)(db:get-value-by-header run-record header key))
					keys))
		       (run-name   (db:get-value-by-header run-record header "runname"))
		       (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
		       (run-path   (append key-vals (list run-name))))
		  (hash-table-set! (dboard:data-run-keys *data*) run-id run-path)
		  (iup:attribute-set! (dboard:data-runs-matrix *data*)
				      (conc rownum ":" colnum) col-name)
		  (hash-table-set! runid-to-col run-id (list colnum run-record))
		  ;; Here we update the tests treebox and tree keys
		  (tree:add-node (dboard:data-tests-tree *data*) "Runs" (append key-vals (list run-name))
				 userdata: (conc "run-id: " run-id))
		  (set! colnum (+ colnum 1))))
	      run-ids)

    ;; Scan all tests to be displayed and organise all the test names, respecting what is in the hash table
    ;; Do this analysis in the order of the run-ids, the most recent run wins
    (for-each (lambda (run-id)
		(let* ((run-path       (hash-table-ref (dboard:data-run-keys *data*) run-id))
		       (test-changes   (hash-table-ref all-test-changes run-id))
		       (new-test-dat   (car test-changes))
		       (removed-tests  (cadr test-changes))
		       (tests          (sort (map cadr (filter (lambda (testrec)
								 (eq? run-id (db:mintest-get-run_id (cadr testrec))))
							       new-test-dat))
					     (lambda (a b)

				     (itempath  (db:mintest-get-item_path test))
				     (fullname  (conc testname "/" itempath))
				     (dispname  (if (string=? itempath "") testname (conc "   " itempath)))
				     (rownum    (hash-table-ref/default testname-to-row fullname #f))
				     (test-path (append run-path (if (equal? itempath "") 
								     (list testname)
								     (list testname itempath))))
				     (tb         (dboard:data-tests-tree *data*)))
				(print "INFONOTE: run-path: " run-path)
				(tree:add-node (dboard:data-tests-tree *data*) "Runs" 
					       test-path
					       userdata: (conc "test-id: " test-id))
				(let ((node-num (tree:find-node tb (cons "Runs" test-path)))
				      (color    (car (gutils:get-color-for-state-status state status))))
				  (debug:print 0 *default-log-port* "node-num: " node-num ", color: " color)
				  (iup:attribute-set! tb (conc "COLOR" node-num) color))
				(hash-table-set! (dboard:data-path-test-ids *data*) test-path test-id)
				(if (not rownum)
				    (let ((rownums (hash-table-values testname-to-row)))
				      (set! rownum (if (null? rownums)
						       1
						       (+ 1 (apply max rownums))))
				      (hash-table-set! testname-to-row fullname rownum)
				      ;; create the label
				      (iup:attribute-set! (dboard:data-runs-matrix *data*)
							  (conc rownum ":" 0) dispname)
				      ))
				;; set the cell text and color
				;; (debug:print 2 *default-log-port* "rownum:colnum=" rownum ":" colnum ", state=" status)
				(iup:attribute-set! (dboard:data-runs-matrix *data*)
						    (conc rownum ":" colnum)
						    (if (member state '("ARCHIVED" "COMPLETED"))
							status
							state))
				(iup:attribute-set! (dboard:data-runs-matrix *data*)
						    (conc "BGCOLOR" rownum ":" colnum)
						    (car (gutils:get-color-for-state-status state status)))
				))
			    tests)))
	      run-ids)

    (let ((updater (hash-table-ref/default  (dboard:data-updaters *data*) window-id #f)))
      (if updater (updater (hash-table-ref/default data get-details-sig #f))))

    (iup:attribute-set! (dboard:data-runs-matrix *data*) "REDRAW" "ALL")
    ;; (debug:print 2 *default-log-port* "run-changes: " run-changes)
    ;; (debug:print 2 *default-log-port* "test-changes: " test-changes)
    (list run-changes all-test-changes)))

;;======================================================================
;; TESTS DATA
;;======================================================================

    ;; (iup:attribute-set! general-matrix "2:1" *toppath*)
    ;; Megatest version
    (iup:attribute-set! general-matrix "2:0" "Version")
    (iup:attribute-set! general-matrix "2:1" (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))

    general-matrix))

(define (dcommon:run-stats dbstruct)
  (let* ((stats-matrix (iup:matrix expand: "YES"))
	 (changed      #f)
	 (updater      (lambda ()
			 (let* ((run-stats    (db:get-run-stats dbstruct))
				(indices      (common:sparse-list-generate-index run-stats)) ;;  proc: set-cell))
				(row-indices  (car indices))
				(col-indices  (cadr indices))
				(max-row      (if (null? row-indices) 1 (apply max (map cadr row-indices))))
				(max-col      (if (null? col-indices) 1 
						  (apply max (map cadr col-indices))))
				(max-visible  (max (- (d:alldat-num-tests *alldat*) 15) 3))
				(max-col-vis  (if (> max-col 10) 10 max-col))
				(numrows      1)
				(numcols      1))
			   (iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS")
			   (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-vis)

      (iup:toggle "Server" #:size "40x")))
    (let ((tb (iup:textbox 
	       #:value "megatest "
	       #:expand "HORIZONTAL"
	       #:readonly "YES"
	       #:font "Courier New, -12"
	       )))
      (dboard:data-command-tb-set! data tb)
      tb)
    (iup:button "Execute" #:size "50x"
		#:action (lambda (obj)
			   (let ((cmd (conc "xterm -geometry 180x20 -e \""
					    (iup:attribute (dboard:data-command-tb data) "VALUE")
					    ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
			     (system cmd)))))))

(define (dcommon:command-action-selector data)
  (iup:frame
   #:title "Set the action to take"
   (iup:hbox
    ;; (iup:label "Command to run" #:expand "HORIZONTAL" #:size "70x" #:alignment "LEFT:ACENTER")
    (let* ((cmds-list '("run" "remove-runs" "set-state-status" "lock-runs" "unlock-runs"))
	   (lb         (iup:listbox #:expand "HORIZONTAL"
				    #:dropdown "YES"
				    #:action (lambda (obj val index lbstate)
					       ;; (print obj " " val " " index " " lbstate)
					       (dboard:data-command-set! data val)
					       (dashboard:update-run-command data))))
	   (default-cmd (car cmds-list)))
      (iuplistbox-fill-list lb cmds-list selected-item: default-cmd)
      (dboard:data-command-set! data default-cmd)
      lb))))

(define (dcommon:command-runname-selector alldat data)
  (iup:frame
   #:title "Runname"
   (let* ((default-run-name (seconds->work-week/day (current-seconds)))
	  (tb (iup:textbox #:expand "HORIZONTAL"
			   #:action (lambda (obj val txt)
				      ;; (print "obj: " obj " val: " val " unk: " unk)
				      (dboard:data-run-name-set! data txt) ;; (iup:attribute obj "VALUE"))
				      (dashboard:update-run-command data))
			   #:value (or default-run-name (dboard:data-run-name data))))
	  (lb (iup:listbox #:expand "HORIZONTAL"
			   #:dropdown "YES"
			   #:action (lambda (obj val index lbstate)
				      (if (not (equal? val ""))
					  (begin
					    (iup:attribute-set! tb "VALUE" val)
					    (dboard:data-run-name-set! data val)
					    (dashboard:update-run-command data))))))
	  (refresh-runs-list (lambda ()
			       (let* ((target        (dboard:data-target-string data))
				      (runs-for-targ (if (d:alldat-useserver alldat)
							 (rmt:get-runs-by-patt (d:alldat-keys alldat) "%" target #f #f #f)
							 (db:get-runs-by-patt (d:alldat-dblocal alldat) (d:alldat-keys alldat) "%" target #f #f #f)))
				      (runs-header   (vector-ref runs-for-targ 0))
				      (runs-dat      (vector-ref runs-for-targ 1))
				      (run-names     (cons default-run-name 
							   (map (lambda (x)
								  (db:get-value-by-header x runs-header "runname"))
								runs-dat))))
				 ;; (iup:attribute-set! lb "REMOVEITEM" "ALL")
				 (iuplistbox-fill-list lb run-names selected-item: default-run-name)))))
     (dboard:data-updater-for-runs-set! data refresh-runs-list)
     (refresh-runs-list)
     (dboard:data-run-name-set! data default-run-name)
     (iup:hbox
      tb
      lb))))

(define (dcommon:command-testname-selector alldat data update-keyvals key-listboxes)
  (iup:frame
   #:title "SELECTORS"
   (iup:vbox
    ;; Text box for test patterns
    (iup:frame
     #:title "Test patterns (one per line)"
     (let ((tb (iup:textbox #:action (lambda (val a b)
				       (dboard:data-test-patts-set!
					*data*
					(dboard:lines->test-patt b))
				       (dashboard:update-run-command data))
			    #:value (dboard:test-patt->lines
				     (dboard:data-test-patts *data*))
			    #:expand "YES"
			    #:size "x50"
			    #:multiline "YES")))
       (set! test-patterns-textbox tb)
       tb))
    (iup:frame
     #:title "Target"

     ;; Text box for STATES
     (iup:frame
      #:title "States"
      (dashboard:text-list-toggle-box 
       ;; Move these definitions to common and find the other useages and replace!
       (map cadr *common:std-states*) ;; '("COMPLETED" "RUNNING" "STUCK" "INCOMPLETE" "LAUNCHED" "REMOTEHOSTSTART" "KILLED")
       (lambda (all)
	 (dboard:data-states-set! *data* all)
	 (dashboard:update-run-command data))))
     ;; Text box for STATES
     (iup:frame
      #:title "Statuses"
      (dashboard:text-list-toggle-box 
       (map cadr *common:std-statuses*) ;; '("PASS" "FAIL" "n/a" "CHECK" "WAIVED" "SKIP" "DELETED" "STUCK/DEAD")
       (lambda (all)
	 (dboard:data-statuses-set! *data* all)
	 (dashboard:update-run-command data))))))))

(define (dcommon:command-tests-tasks-canvas data test-records sorted-testnames tests-draw-state)
  (iup:frame
   #:title "Tests and Tasks"
   (let* ((updater #f)
	  (last-xadj 0)

								  (newpatt-list (if selected
										    (cons test-name patterns)
										    (delete test-name patterns)))
								  (newpatt      (string-intersperse newpatt-list "\n")))
							     (iup:attribute-set! obj "REDRAW" "ALL")
							     (hash-table-set! selected-tests test-name selected)
							     (iup:attribute-set! test-patterns-textbox "VALUE" newpatt)
							     (dboard:data-test-patts-set! data (dboard:lines->test-patt newpatt))
							     (dashboard:update-run-command data)
							     (if updater (updater last-xadj last-yadj)))))))
						 (hash-table-keys tests-info)))))))
     canvas-obj)))

;;======================================================================
;;  S T E P S

		  (debug:print 4 *default-log-port* "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results)
		  (if (and (null? results)
			   (not (null? tal)))
		      (loop (car tal)(cdr tal))
		      (if (null? results) #f
			  (car results))))))))))




;;======================================================================
;;  S T E P S
;;======================================================================

;; Getting steps is more complicated.
;;
;; If given work area