Megatest

;;======================================================================
;; Copyright 2006-2016, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(declare (uses common))
(declare (uses mtargs))
(declare (uses mtargs.import))
(declare (uses keys))
(declare (uses items))
(declare (uses debugprint))
(declare (uses debugprint.import))
(declare (uses db))
(declare (uses configf))
(declare (uses process))
(declare (uses launch))
(declare (uses runs))
(declare (uses dashboard-tests))
(declare (uses tree))
(declare (uses dcommon))
(declare (uses dashboard-context-menu))
(declare (uses vg))
(declare (uses subrun))
(declare (uses mt))
(declare (uses dbmod))
(declare (uses dbfile))
(declare (uses dbfile.import))
(declare (uses rmtmod))
(declare (uses rmtmod.import))
(declare (uses commonmod))
(declare (uses commonmod.import))

(use format)

(require-library iup)
(import (prefix iup iup:))

(use canvas-draw)
(import canvas-draw-iup
	(prefix sqlite3 sqlite3:))

(use ducttape-lib)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors) ;; defstruct


(import commonmod
	(prefix mtargs args:)


	dbmod
	dbfile






	rmtmod

	debugprint)




(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")

;; set some parameters here - these need to be put in something that can be loaded from other
;; executables such as dashboard and mtutil
;;
(include "dashboard-transport-mode.scm")
(dbfile:db-init-proc db:initialize-main-db)
(set! rmtmod:send-receive rmt:send-receive)

(debug:print-info 0 *default-log-port* "transport-mode="(rmt:transport-mode))

(define help (conc 
	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest version " megatest-version 

              " license GPL, Copyright (C) Matt Welland 2012-2017

Usage: dashboard [options]
  -h                    : this help
  -test run-id test-id  : open a test control panel on this test
  -skip-version-check   : skip the version check


  -rows R         : set number of rows
  -cols C         : set number of columns
  -start-dir dir  : start dashboard in the given directory
  -target target  : filter runs tab to given target.
  -debug  n[,n]   : set debug level(s) e.g. -debug 4 or -debug 0,9
  -repl           : Start a chicken scheme interpreter
  -mode MODE      : tcp or nfs
"
))





;; process args
(define remargs (args:get-args 
		 (argv)
                 ;; parameters (need arguments)
		 (list  "-rows"
			"-cols"

			"-test" ;; given a run id and test id, open only a test control panel on that test..

			"-debug"
                        "-start-dir"
                        "-target"
			"-mode"  ;; tcp or nfs
			) 
                 ;; switches (don't take arguments)
		 (list  "-h"






			"-skip-version-check"
			"-repl"
			"-:p"     ;; ignore the built in chicken profiling switch
			)
		 args:arg-hash
		 0))

(if (args:get-arg "-mode")
    (let* ((mode (string->symbol (args:get-arg "-mode"))))
      (rmt:transport-mode mode)))
;;  (rmt:transport-mode 'tcp))

(if (args:get-arg "-test") ;; need to use tcp for test control panel
    (rmt:transport-mode 'tcp))

;; RA => Might require revert for filters 
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn")

;; (thread-start! (make-thread common:watchdog "Watchdog thread"))
;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn")
;; (if (not (args:get-arg "-use-db-cache"))
;;     (begin


;;       (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
;;       (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;)
;;)

;; data common to all tabs goes here
;;
;; Moved to dcommon.scm
;;
;; (defstruct dboard:commondat
;;   ((curr-tab-num 0) : number)
;;   please-update  
;;   tabdats
;;   update-mutex
;;   updaters 
;;   updating
;;   uidat ;; needs to move to tabdat at some time
;;   hide-not-hide-tabs

;;   target
;;   )
;;
;; (define (dboard:commondat-make)
;;   (make-dboard:commondat
;;    curr-tab-num:         0
;;    tabdats:              (make-hash-table)
;;    please-update:        #t
;;    update-mutex:         (make-mutex)
;;    updaters:             (make-hash-table)
;;    updating:             #f
;;    hide-not-hide-tabs:   #f
;;    target:               ""
;;    ))

(set! *journal-stats-enable* #f)

;;======================================================================
;; buttons color using image
;;======================================================================

(define *images* (make-hash-table))

(define (make-image images name color)
  (if (hash-table-exists? images name)
      name
      (let* ((img-bits1 (u8vector->blob (u8vector
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 

					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
					 )))
	     ;;                       w h

	     (img1 (iup:image/palette 16 24 img-bits1)))
	(iup:handle-name-set! img1 name)
	;; (iup:attribute-set! img1 "0" "0 0 0")
	(iup:attribute-set! img1 "1" color) ;; "BGCOLOR")
	;; (iup:attribute-set! img1 "2" "255 0 0")
	(hash-table-set! images name img1)

	name)))


;; gets and calls updater list based on curr-tab-num
;;
(define (dboard:common-run-curr-updaters commondat #!key (tab-num #f))
  ;; (sync-db-to-tmp (dboard:common-get-tabdat commondat tab-num: tab-num)) ;; no longer applies

  ;; maybe need sleep here?

  (if (dboard:common-get-tabdat commondat tab-num: tab-num) ;; only update if there is a tabdat
      (let* ((tnum     (or tab-num (dboard:commondat-curr-tab-num commondat)))
	     (updaters (hash-table-ref/default (dboard:commondat-updaters commondat)
					       tnum
					       '())))
	(debug:print 4 *default-log-port* "Found these updaters: " updaters " for tab-num: " tnum)
	(for-each ;; perform the function calls for the complete updaters list
	 (lambda (updater)
          ;; (debug:print 3 *default-log-port* "Running " updater)
	   (updater))
	 updaters))))

;; if tab-num passed in then use it, otherwise look in commondat at curr-tab-num
;; adds the updater passed in the updaters list at that hashkey
;;
(define (dboard:commondat-add-updater commondat updater #!key (tab-num #f))
  (let* ((tnum          (or tab-num
			     (dboard:commondat-curr-tab-num commondat)))
	 (curr-updaters (hash-table-ref/default (dboard:commondat-updaters commondat) tnum '())))
    (hash-table-set! (dboard:commondat-updaters commondat)
		     tnum
		     (cons updater curr-updaters))))

;; data for each specific tab goes here
;;
(defstruct dboard:tabdat 
  ;; runs
  ((allruns         '())                 : list)        ;; list of dboard:rundat records
  ((allruns-by-id    (make-hash-table))  : hash-table)  ;; hash of run-id -> dboard:rundat records
  ((done-runs       '())                 : list)        ;; list of runs already drawn
  ((not-done-runs   '())                 : list)        ;; list of runs not yet drawn
  (header            #f)                                ;; header for decoding the run records
  (keys              #f)                                ;; keys for this run (i.e. target components)
  ((numruns          (string->number (or (args:get-arg "-cols")
					 (configf:lookup *configdat* "dashboard" "cols")
					 "8")))                 : number)      ;; 
  ((tot-runs          0)                 : number)
  ((last-data-update  0)                 : number)      ;; last time the data in allruns was updated
  ((last-runs-update  0)                 : number)      ;; last time we pulled the runs info to update the tree
  (runs-mutex         (make-mutex))                     ;; use to prevent parallel access to draw objects
  ((run-update-times  (make-hash-table)) : hash-table)  ;; update times indexed by run-id
  ((last-test-dat      (make-hash-table)) : hash-table)  ;; cache last tests dat by run-id
  ((run-db-paths      (make-hash-table)) : hash-table)  ;; cache the paths to the run db files

  ;; Runs view
  ((buttondat         (make-hash-table)) : hash-table)  ;;     
  ((item-test-names  '())                : list)        ;; list of itemized tests
  ((run-keys          (make-hash-table)) : hash-table)
  (runs-matrix        #f)                               ;; used in newdashboard
  ((start-run-offset   0)                : number)      ;; left-right slider value
  ((start-test-offset  0)                : number)      ;; up-down slider value
  ((runs-btn-height    (or (configf:lookup *configdat* "dashboard" "btn-height") "x16")) : string)  ;; was 12
  ((runs-btn-fontsz    (or (configf:lookup *configdat* "dashboard" "btn-fontsz") "10")) : string)   ;; was 8
  ((runs-cell-width    (or (configf:lookup *configdat* "dashboard" "cell-width") "50")) : string)   ;; was 50
  ((all-test-names     '())              : list)
  
  ;; Canvas and drawing data
  (cnv                #f)
  (cnv-obj            #f)
  (drawing            #f)
  ((run-start-row     0)                 : number)
  ((max-row           0)                 : number)
  ((running-layout    #f)                : boolean)
  (originx            #f)
  (originy            #f)
  ((layout-update-ok  #t)                : boolean)
  ((compact-layout    #t)                : boolean)

  ;; Run times layout
  ;; (graph-button-box #f) ;; RA => Think it is not referenced anywhere
  (graph-matrix     #f)
  ((graph-matrix-table (make-hash-table)) : hash-table) ;; graph-dats referenced thru graph name info
  ((graph-cell-table (make-hash-table)) : hash-table) ;; graph-dats referenced thru matrix cell info
  ((graph-matrix-row 1) : number)
  ((graph-matrix-col 1) : number)

  ;; Controls used to launch runs etc.
  ((command          "")                 : string)      ;; for run control this is the command being built up
  (command-tb        #f)	                        ;; widget for the type of command; run, remove-runs etc.
  (test-patterns-textbox #f)                            ;; text box widget for editing a list of test patterns
  (key-listboxes     #f)			         
  (key-lbs           #f)			         
  run-name                                              ;; from run name setting widget
  states                                                ;; states for -state s1,s2 ...
  statuses                                              ;; statuses for -status s1,s2 ...
						         
  ;; Selector variables				         
  curr-run-id                                           ;; current row to display in Run summary view
  prev-run-id                                           ;; previous runid selected before current runid was selected (used in xor-two-runs runs summary mode
  curr-test-ids                                         ;; used only in dcommon:run-update which is used in newdashboard
  ((filters-changed  #t)                  : boolean)    ;; to indicate that the user changed filters for this tab
  ((last-filter-str  "")                  : string)      ;; conc the target runname and testpatt for a signature of changed filters
  ((hide-empty-runs  #f)                  : boolean)     
  ((hide-not-hide    #t)                  : boolean)     ;; toggle for hide/not hide empty runs
  (hide-not-hide-button #f)
  ((searchpatts        (make-hash-table)) : hash-table)  ;;
  ((state-ignore-hash  (make-hash-table)) : hash-table)  ;; hash of  STATE => #t/#f for display control
  ((status-ignore-hash (make-hash-table)) : hash-table)  ;; hash of STATUS => #t/#f
  (target              #f)
  (test-patts          #f)

  ;; db info to file the .db files for the area
  (access-mode        (db:get-access-mode))             ;; use cached db or not
  (dbdir               #f)
  (dbfpath             #f)
  (dbkeys              #f)
  ((last-db-update     (make-hash-table)) : hash-table) ;; last db file timestamp
  (monitor-db-path     #f)                              ;; where to find monitor.db
  ro                                                    ;; is the database read-only?

  ;; tests data
  ((num-tests          10)               : number)      ;; total number of tests to show (used in the old runs display)

  ;; runs tree
  ((path-run-ids       (make-hash-table)) : hash-table) ;; path (target / runname) => id
  (runs-tree           #f)
  ((runs-tree-ht       (make-hash-table)) : hash-table) ;; track which targets added to tree (merge functionality with path-run-ids?)

  ;; tab data
  ((view-changed       #t)                : boolean)   
  ((xadj               0)                 : number)     ;; x slider number (if using canvas)
  ((yadj               0)                 : number)     ;; y slider number (if using canvas)
  ;; runs-summary tab state
  ((runs-summary-modes '((one-run . "Show One Run") (xor-two-runs . "XOR Two Runs") (xor-two-runs-hide-clean . "XOR; Hide Clean")) )   : list)
  ((runs-summary-mode-buttons '())               : list)
  ((runs-summary-mode  'one-run)            : symbol)
  ((runs-summary-mode-change-callbacks '()) : list)
  (runs-summary-source-runname-label #f)
  (runs-summary-dest-runname-label #f)
  ;; runs summary view
  
  tests-tree       ;; used in newdashboard
  )

;; register tabdat with BBpp
;; this is used by BBpp (Brandon's pretty printer) to convert dboard:tabdat into a composition of lists that pp will handle
;; (hash-table-set! *BBpp_custom_expanders_list* TABDAT:
;;                  (cons dboard:tabdat?
;;                        (lambda (tabdat-item)
;;                          (filter
;;                           (lambda (alist-entry)
;;                             (member (car alist-entry)
;;                                     '(allruns-by-id allruns))) ;; FIELDS OF INTEREST
;;                           (dboard:tabdat->alist tabdat-item)))))



(define (dboard:tabdat-target-string vec)
  (let ((targ (dboard:tabdat-target vec)))
    (if (list? targ)(string-intersperse targ "/") "no-target-specified")))

(define (dboard:tabdat-test-patts-use vec)    
  (let ((val (dboard:tabdat-test-patts vec)))(if val val ""))) ;;RADT => What is the if for?

;; additional setters for dboard:data
(define (dboard:tabdat-test-patts-set!-use    vec val)
  (dboard:tabdat-test-patts-set! vec (if (equal? val "") #f val)))

(define (dboard:tabdat-make-data)
  (let ((dat (make-dboard:tabdat)))
    (dboard:setup-tabdat dat)
    (dboard:setup-num-rows dat)
    dat))

(define (dboard:setup-tabdat tabdat)
  (dboard:tabdat-dbdir-set! tabdat (common:make-tmpdir-name *toppath* "")) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
  (dboard:tabdat-dbfpath-set! tabdat (common:make-tmpdir-name *toppath* ""))
  (dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db"))


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

  (dboard:tabdat-keys-set! tabdat (rmt:get-keys))
  (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname")))
  (dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%"))
  )

;; RADT => Matrix defstruct addition
(defstruct dboard:graph-dat
    ((id           #f) : string)
    ((color        #f) : vector)
    ((flag         #t) : boolean)
    ((cell         #f) : number)
    )

;; data for runs, tests etc. was used in run summary?
;;
(defstruct dboard:runsdat
  ;; new system
  runs-index    ;; target/runname => colnum
  tests-index   ;; testname/itempath => rownum
  matrix-dat    ;; vector of vectors rows/cols
  )

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

;; duplicated in dcommon.scm
;;
;; ;; used to keep the rundata from rmt:get-tests-for-run
;; ;; in sync. 
;; ;;
;; (defstruct dboard:rundat
;;   run
;;   tests-drawn    ;; list of id's already drawn on screen
;;   tests-notdrawn ;; list of id's NOT already drawn
;;   rowsused       ;; hash of lists covering what areas used - replace with quadtree
;;   hierdat        ;; put hierarchial sorted list here
;;   tests          ;; hash of id => testdat
;;   ((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat
;;   key-vals
;;   ((last-update   0)                 : number)    ;; last query to db got records from before last-update
;;   ((last-db-time  0)                 : number)    ;; last timestamp on main.db
;;   ((data-changed  #f)                : boolean)   
;;   ((run-data-offset  0)              : number)      ;; get only 100 items per call, set back to zero when received less than 100 items
;;   (db-path #f))

;; for the new runs view lets build up a few new record types and then consolidate later
;;
;; this is a two level deep pipeline for the incoming data:
;;   sql query data ==> filters ==> data for display
;;
(defstruct dboard:rdat
  ;; view related items
  (runnum    0) ;; which column we are processing, index into runsbynum, we sweep across all these runs then start over
  (leftcol   0) ;; number of the leftmost visible column
  (toprow    0) ;; topmost visible row
  (numcols  24) ;; number of columns visible
  (numrows  20) ;; number of rows visible
  
  ;; data from sql db
  (keys       (rmt:get-keys))         ;; to be removed when targets handling is refactored
  (runs       (make-sparse-vector))   ;; id => runrec
  (runsbynum  (make-vector 100 #f))   ;; vector num => runrec 
  (targ-runid (make-hash-table))      ;; area/target/runname => run-id  ;; not sure this will be needed
  (tests      (make-hash-table))      ;; test[/itempath] => list of test rec

  ;; run sql filters 
  (targ-sql-filt        "%")
  (runname-sql-filt     "%")
  (run-state-sql-filt   "%")
  (run-status-sql-filt  "%")

  ;; test sql filter
  (testname-sql-filt    "%")
  (itempath-sql-filt    "%")
  (test-state-sql-filt  "%")
  (test-status-sql-filt "%")

  ;; other sql related fields
  (last-updates (make-sparse-vector 0))  ;; run-id -> timestamp of the last update from sql db, set to zero on any field changes

  ;; filtered data
  (cols  (make-sparse-vector))   ;; columnnum => run-id
  (tests (make-hash-table))      ;; test[/itempath] => (vector columnnum => test rec)

  ;; various
  (prev-run-ids  '())            ;; push previously looked at runs on this
  (view-changed #f)

  ;; widgets
  (runs-tree #f)                 ;; 
  )

(define (dboard:rdat-push-run-id rdat run-id)
  (dboard:rdat-prev-run-ids-set! rdat (cons run-id (dboard:rdat-prev-run-ids rdat))))

(defstruct dboard:runrec
  id
  target  ;; a/b/c...
  tdef    ;; for future use
  )
     
(defstruct dboard:testrec
  id
  runid
  testname  ;; test[/itempath]
  state
  status
  start-time
  duration
  )

;; register dboard:rundat with BBpp
;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle
;; (hash-table-set! *BBpp_custom_expanders_list* RUNDAT:
;;                  (cons dboard:rundat?
;;                        (lambda (tabdat-item)
;;                          (filter
;;                           (lambda (alist-entry)
;;                             (member (car alist-entry)
;;                                     '(run run-data-offset ))) ;; FIELDS OF INTEREST
;;                           (dboard:rundat->alist tabdat-item)))))




(define (dboard:rundat-make-init #!key (run #f)(key-vals #f)(tests #f));; -100 is before time began
  (make-dboard:rundat 
   run: run
   tests: (or tests (make-hash-table))
   key-vals: key-vals 
   )) 













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























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

  (let ((t-sort (assoc (configf:lookup *configdat* "dashboard" "testsort") *tests-sort-type-index*)))
    (if t-sort
	(cadr t-sort)
	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))

;; This is roughly the same as dboard:get-tests-dat, should merge them if possible
;;
;; gets all the tests for run-id that match testnamepatt and key-vals, merges them
;;
;;    NOTE: Yes, this is used
;;
(define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)
  (let* ((start-time   (current-seconds))
	 (access-mode  (dboard:tabdat-access-mode tabdat))
         (num-to-get   (string->number (or (configf:lookup *configdat* "setup" "num-tests-to-get")
                                           "1000")))
	 (states       (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)))
	 (statuses     (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)))
         (do-not-use-db-file-timestamps #f) ;; (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")) ;; this still hosts runs-summary-tab
         (do-not-use-query-timestamps   #t) ;; (configf:lookup *configdat* "setup" "do-not-use-query-timestamps")) ;; this no longer troubles runs-summary-tab
	 (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))
	 ;; note: the rundat is normally created in "update-rundat". 
	 (run-dat      (or (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f)
			   (let ((rd (dboard:rundat-make-init run: run key-vals: key-vals)))
			     (hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id rd)
			     rd)))
	 ;; (prev-tests  (dboard:rundat-tests prev-dat)) ;; (vector-ref prev-dat 1))
         (last-update  (if ;;(or
                        do-not-use-query-timestamps
                        ;;(dboard:tabdat-filters-changed tabdat))
                        0
                        (dboard:rundat-last-update run-dat)))
	 (last-db-time (if do-not-use-db-file-timestamps
			   0
			   (dboard:rundat-last-db-time run-dat)))
	 (db-path      (or (dboard:rundat-db-path run-dat)
			   (let* ((db-dir (get-environment-variable "MT_RUN_AREA_HOME")) ;;  (common:get-db-tmp-area))
				  (db-pth (conc db-dir "/.mtdb/*.db")))
			     (dboard:rundat-db-path-set! run-dat db-pth) ;; this is just a cache of the path
			     db-pth)))
	 (db-mod-time  (common:lazy-sqlite-db-modification-time db-path))
	 (db-modified  (>= db-mod-time last-db-time))
	 (multi-get    (> (dboard:rundat-run-data-offset run-dat) 0))  ;; multi-get in progress
	 (tmptests     (if (or do-not-use-db-file-timestamps
			       (dboard:tabdat-filters-changed tabdat)
			       db-modified)
			   (rmt:get-tests-for-run run-id testnamepatt states statuses     ;; run-id testpatt states statuses
					      (dboard:rundat-run-data-offset run-dat) ;; query offset
					      num-to-get
					      (dboard:tabdat-hide-not-hide tabdat) ;; no-in
					      sort-by                              ;; sort-by
					      sort-order                           ;; sort-order
					      'shortlist                           ;; qrytype (was #f)


					      last-update                          ;; last-update
					      *dashboard-mode*)                    ;; use dashboard mode
			   '()))
	 (use-new    (dboard:tabdat-hide-not-hide tabdat))
	 (tests-ht   (if (dboard:tabdat-filters-changed tabdat)
			 (let ((ht (make-hash-table)))
			   (dboard:rundat-tests-set! run-dat ht)
			   ht)
			 (dboard:rundat-tests run-dat)))

	 (got-all      (< (length tmptests) num-to-get))               ;; got all for this round  
	 )
    ;; (debug:print-info 0 *default-log-port* "got-all="got-all", (hash-table-size tests-ht)="(hash-table-size tests-ht))
    ;; if we saw the db modified, reset it (the signal has already been used)
    (if (and got-all ;; (not multi-get)
	     db-modified)
       (dboard:rundat-last-db-time-set!    run-dat (- start-time 2)))

    ;; to limit the amount of data transferred each cycle use limit of num-to-get and offset
    ;; DO NOT bump time indexes last-update and last-db-time until all the first pass of the
    ;; data has been read
    ;; set last-update to 0 if still getting data incrementally ;; NO NEED, handled above
    ;;
    ;; (debug:print 0 *default-log-port* "got-all: " got-all " multi-get: " multi-get " num-to-get: " num-to-get " (length tmptests): " (length tmptests) " db-modified: " db-modified " db-mod-time: " db-mod-time " db-path: " db-path)
    (if got-all
	(begin
	  (dboard:rundat-last-update-set!     run-dat (- start-time 2))
	  (dboard:rundat-run-data-offset-set! run-dat 0))
	(begin
	  (dboard:rundat-run-data-offset-set! run-dat


					      (+ num-to-get (dboard:rundat-run-data-offset run-dat)))))



    (for-each 
     (lambda (tdat)
       (let ((test-id (db:test-get-id tdat))
	     (state   (db:test-get-state tdat)))
        (dboard:rundat-data-changed-set! run-dat #t)
        (if (equal? state "DELETED")
            (hash-table-delete! tests-ht test-id)
	    (hash-table-set! tests-ht test-id tdat))))
      tmptests)










    tests-ht))

;; tmptests   - new tests data
;; prev-tests - old tests data
;;
;; (define (dashboard:merge-changed-tests tabdat tests tmptests) ;;  use-new prev-tests) 
;;   (let* ((newdat     (filter

;; this calls dboard:get-tests-for-run-duplicate for each run
;;
;; create a virtual table of all the tests
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
;;
(define (update-rundat tabdat runnamepatt numruns testnamepatt keypatts)
  (let* ((access-mode      (dboard:tabdat-access-mode tabdat))
         (keys             (rmt:get-keys))
	 (last-runs-update (- (dboard:tabdat-last-runs-update tabdat) 2))
         (allruns          (rmt:get-runs runnamepatt numruns (dboard:tabdat-start-run-offset tabdat) keypatts))
         ;;(allruns-tree (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f))
         (allruns-tree    (rmt:get-runs-by-patt keys "%" #f #f #f #f last-runs-update)) ;;'("id" "runname")
	 (header      (db:get-header allruns))
	 (runs        (db:get-rows   allruns)) ;; RA => Filtered as per runpatt selected
         (runs-tree   (db:get-rows   allruns-tree)) ;; RA => Returns complete list of runs
	 (start-time  (current-seconds))
	 (runs-hash   (let ((ht (make-hash-table)))
			 (for-each (lambda (run)
				     (hash-table-set! ht (db:get-value-by-header run header "id") run))
				   runs-tree) ;; (vector-ref runs-dat 1))
			 ht))
	 (tb          (dboard:tabdat-runs-tree tabdat)))
    ;;(BB> "In update-rundat")
    ;;(inspect allruns runs-hash)
    (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
    (dboard:tabdat-header-set! tabdat header)
    ;; 
    ;; trim runs to only those that are changing often here
    ;; 
    (if (null? runs)
	(begin

		   (elapsed-time (- (current-seconds) start-time)))
	      (if (null? all-test-ids)
		  (hash-table-delete! (dboard:tabdat-allruns-by-id tabdat) run-id)
		  (hash-table-set!    (dboard:tabdat-allruns-by-id tabdat) run-id run-struct))
	      (if (or (null? tal)
		      (> elapsed-time 2)) ;; stop loading data after 5 seconds, on the next call more data *should* be loaded since get-tests-for-run uses last update
		  (begin
		    (if (> elapsed-time 2)(debug:print 0 *default-log-port*  "WARNING: timed out in update-testdat " elapsed-time "s"))
		    (dboard:tabdat-allruns-set! tabdat new-res)
		    maxtests)
		  (if (> (dboard:rundat-run-data-offset run-struct) 0)
		      (loop run tal new-res newmaxtests) ;; not done getting data for this run
		      (loop (car tal)(cdr tal) new-res newmaxtests)))))))
    (dboard:tabdat-filters-changed-set! tabdat #f)
    (dboard:update-tree tabdat runs-hash header tb)))


(define *dashboard-last-run-id-update* (make-hash-table)) ;; id => seconds

(define (dboard:clear-run-id-update-hash)
  (hash-table-clear! *dashboard-last-run-id-update*))

;; this calls dboard:get-tests-for-run-duplicate for each run
;;
;; create a virtual table of all the tests
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
;;
(define (dboard:update-rundat tabdat runnamepatt numruns testnamepatt keypatts)
  (let* ((access-mode      (dboard:tabdat-access-mode tabdat))
         (keys             (dboard:tabdat-keys tabdat)) ;; (db:dispatch-query access-mode rmt:get-keys db:get-keys)))
	 (last-runs-update (- (dboard:tabdat-last-runs-update tabdat) 2))
         (allruns          (rmt:get-runs runnamepatt numruns (dboard:tabdat-start-run-offset tabdat) keypatts))
         ;;(allruns-tree (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f))
         (allruns-tree    (rmt:get-runs-by-patt keys "%" #f #f #f #f 0)) ;; last-runs-update));;'("id" "runname")
	 (header      (db:get-header allruns))
	 (runs        (db:get-rows   allruns)) ;; RA => Filtered as per runpatt selected
         (runs-tree   (db:get-rows   allruns-tree)) ;; RA => Returns complete list of runs
	 (start-time  (current-seconds))
	 (runs-hash   (let ((ht (make-hash-table)))
			 (for-each (lambda (run)
				     (hash-table-set! ht (db:get-value-by-header run header "id") run))
				   runs-tree) ;; (vector-ref runs-dat 1))
			 ht))
	 (tb          (dboard:tabdat-runs-tree tabdat)))
    (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
    (dboard:tabdat-header-set! tabdat header)
    ;; 
    ;; trim runs to only those that are changing often here
    ;; 
    (if (null? runs)
	(begin
	  (dboard:tabdat-allruns-set! tabdat '())
	  (dboard:tabdat-all-test-names-set! tabdat '())
	  (dboard:tabdat-item-test-names-set! tabdat '())
	  (hash-table-clear! (dboard:tabdat-allruns-by-id tabdat)))
	(let loop ((run      (car runs))
		   (tal      (cdr runs))
		   (res     '())
		   (maxtests 0)
		   (cont-run #f))
	  (let* ((run-id       (db:get-value-by-header run header "id"))
		 (recently-done  (< (- (current-seconds)
				       (hash-table-ref/default *dashboard-last-run-id-update* run-id 0)) 1))
		 (run-struct   (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f))
		 ;; (last-update  (if run-struct (dboard:rundat-last-update run-struct) 0))
		 (key-vals     (rmt:get-key-vals run-id))
		 (tests-ht     (let* ((tht (if (and recently-done run-struct)
					       (let ((rht (dboard:rundat-tests run-struct))) ;; (dboard:tabdat-allruns-by-id tabdat)))
						 (or rht
						     (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)))
					       (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))))
                                (assert (hash-table? tht) "FATAL: But here tht should be a hash-table")
				 tht))
		 ;; GET RID OF dboard:get-tests-dat - it is superceded by dboard:get-tests-for-run-duplicate
		 ;;  dboard:get-tests-for-run-duplicate - returns a hash table
		 ;;  (dboard:get-tests-dat tabdat run-id last-update))
		 (all-test-ids (hash-table-keys tests-ht))
		 (num-tests    (length all-test-ids))
		 ;; (print "run-struct: " run-struct)
		 ;; NOTE: bubble-up also sets the global (dboard:tabdat-item-test-names tabdat)
		 ;; (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?
		 (newmaxtests (max num-tests maxtests))
		 ;; (last-update (- (current-seconds) 10))
		 (run-struct  (or run-struct
				  (dboard:rundat-make-init
				   run:         run 
				   tests:       tests-ht
				   key-vals:    key-vals)))
		 (new-res     (if (null? all-test-ids)
				  res
				  (delete-duplicates
				   (cons run-struct res)
				   (lambda (a b)
				     (eq? (db:get-value-by-header (dboard:rundat-run a) header "id")
					  (db:get-value-by-header (dboard:rundat-run b) header "id"))))))
		 (elapsed-time (- (current-seconds) start-time)))
	    (if (null? all-test-ids)
		  (hash-table-delete! (dboard:tabdat-allruns-by-id tabdat) run-id)
		  (hash-table-set!    (dboard:tabdat-allruns-by-id tabdat) run-id run-struct))
	   
	    (if (or (null? tal)
		    (> elapsed-time 2)) ;; stop loading data after 5
					;; seconds, on the next call
					;; more data *should* be
					;; loaded since
					;; get-tests-for-run uses last
					;; update
		(begin
		  (when (> elapsed-time 2)   
		    (debug:print 2 *default-log-port* "NOTE: updates are taking a long time, " elapsed-time "s elapsed.")
		    (let* ((old-val (iup:attribute *tim* "TIME"))
			   (new-val (number->string (inexact->exact (floor (* 2  (string->number old-val)))))))
		      (if (< (string->number new-val) 5000)
			  (begin
			    (debug:print 2 *default-log-port* "NOTE: increasing poll interval from "old-val" to "new-val)
			    (iup:attribute-set! *tim* "TIME" new-val)))))
		  (dboard:tabdat-allruns-set! tabdat new-res)
		  maxtests)
		(if (> (dboard:rundat-run-data-offset run-struct) 0)
		      (begin
			(thread-sleep! 0.2) ;; let the gui re-draw
			(loop run tal new-res newmaxtests #t)) ;; not done getting data for this run
		      (begin
			(hash-table-set! *dashboard-last-run-id-update* run-id (current-seconds))
			(loop (car tal)(cdr tal) new-res newmaxtests #f)))))))
	(dboard:tabdat-filters-changed-set! tabdat #f)
	(dboard:update-tree tabdat runs-hash header tb)))

(define *collapsed* (make-hash-table))

(define (toggle-hide lnum uidat) ; 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")s
	  (hash-table-delete! *collapsed* basetestname))
	(begin
					;(iup:attribute-set! btn "FGCOLOR" "0 192 192")
	  (hash-table-set! *collapsed* basetestname #t)))))

(define blank-line-rx (regexp "^\\s*$"))

				(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-itemized-tests test-dats)
  (let ((tnames '()))
    (for-each (lambda (tdat)
		(let ((tname (vector-ref tdat 0))  ;; (db:test-get-testname tdat))
		      (ipath (vector-ref tdat 1))) ;; (db:test-get-item-path tdat)))
		  (if (not (equal? ipath ""))
		      (if (and (list? tnames)
			       (string? tname)
			       (not (member tname tnames)))
			  (set! tnames (cons tname tnames))))))
	      test-dats)
    (reverse 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 tabdat test-dats #!key (priority 'itempath))
  (if (null? test-dats)
      test-dats
      (begin
	(let* ((tnames   '())                ;; list of names used to reserve order
	       (tests-ht  (make-hash-table))  ;; hash of lists, used to build as we go
	       (itemized (get-itemized-tests test-dats)))
	  #;(for-each 
	   (lambda (testdat)
	     (let* ((tname (vector-ref testdat 0))  ;; db:test-get-testname testdat))
		    (ipath (vector-ref testdat 1))) ;; db:test-get-item-path testdat)))
	       ;;   (seen  (hash-table-ref/default tests-th tname #f)))
	       (if (not (member tname tnames))
		   (if (or (and (eq? priority 'itempath)
				(not (equal? ipath "")))
			   (and (eq? priority 'testname)
				(equal? ipath ""))
			   (not (member tname itemized)))
		       (set! tnames (append tnames (list tname)))))
	       (if (equal? ipath "")
		   ;; This a top level, prepend it
		   (hash-table-set! tests-ht tname (cons testdat (hash-table-ref/default tests-ht tname '())))
		   ;; This is item, append it
		   (hash-table-set! tests-ht tname (append (hash-table-ref/default tests-ht tname '())(list testdat))))))
	  test-dats)
	  ;; 1. put all test/items into lists in tests-ht
	  (for-each
	   (lambda (testdat)
	     (let* ((tname (vector-ref testdat 0))  ;; db:test-get-testname testdat))
		    (ipath (vector-ref testdat 1))) ;; db:test-get-item-path testdat)))
	       ;;   (seen  (hash-table-ref/default tests-ht tname #f)))
	       (if (not (member tname tnames))
		   (if (or (and (eq? priority 'itempath)
				(not (equal? ipath "")))
			   (and (eq? priority 'testname)
				(equal? ipath ""))
			   (not (member tname itemized)))
		       (set! tnames (append tnames (list tname)))))
	       (hash-table-set! tests-ht tname (cons testdat (hash-table-ref/default tests-ht tname '())))))
	   test-dats)
	  ;; now bubble up the non-item test in itemized tests
	  (hash-table-for-each
	   tests-ht
	   (lambda (k v)
	     (if (> (length v) 1) ;; must be itemized, push the no-item to the front
		 (hash-table-set! tests-ht k (sort v (lambda (a b)(not (equal? (vector-ref b 1) ""))))))))
	  ;; Set all tests with items 
	  (dboard:tabdat-item-test-names-set! tabdat (append (if (null? tnames)
							      '()
							      (filter (lambda (tname)
									(let ((tlst (hash-table-ref tests-ht tname)))
									  (and (list tlst)
									       (> (length tlst) 1))))
								      tnames))
							  (dboard:tabdat-item-test-names tabdat)))
	  (let loop ((hed (car tnames))
		     (tal (cdr tnames))
		     (res '()))
	    (let ((newres (append res (hash-table-ref tests-ht hed))))
	      (if (null? tal)
		  newres
		  (loop (car tal)(cdr tal) newres))))))))

;; optimized to get runs constrained by what is visible on the screen
;;  - not appropriate for where all the runs are needed
;;
(define (update-buttons tabdat uidat numruns numtests)
  (let* ((runs        (if (> (length (dboard:tabdat-allruns tabdat)) numruns)
			  (take-right (dboard:tabdat-allruns tabdat) numruns)
			  (pad-list   (dboard:tabdat-allruns tabdat) numruns)))
	 (lftcol      (dboard:uidat-get-lftcol uidat))
	 (tableheader (dboard:uidat-get-header uidat))
	 (table       (dboard:uidat-get-runsvec uidat))
	 (coln        0)
	 (all-test-names (make-hash-table))
	 (use-bgcolor (equal? (configf:lookup *configdat* "dashboard" "use-bgcolor") "yes")) ;; doesn't work
	 )
    ;; create a concise list of test names
    ;;
    (for-each
     (lambda (rundat)
       (if rundat
	   (let* ((testdats  (dboard:rundat-tests rundat))
		  (testnames (map test:test-get-fullname (hash-table-values testdats))))
	     (dcommon:rundat-copy-tests-to-by-name rundat)
	     ;; for the normalized list of testnames (union of all runs)
	     (if (not (and (dboard:tabdat-hide-empty-runs tabdat)
			   (null? testnames)))
		 (for-each (lambda (testname)
			     (hash-table-set! all-test-names testname #t))
			   testnames)))))
     runs)

     tabdat
     (let ((xl (if (> (length (dboard:tabdat-all-test-names tabdat)) (dboard:tabdat-start-test-offset tabdat))
		   (drop (dboard:tabdat-all-test-names tabdat)
			 (dboard:tabdat-start-test-offset tabdat))
		   '())))
       (append xl (make-list (- (dboard:tabdat-num-tests tabdat) (length xl)) ""))))
    (update-labels uidat (dboard:tabdat-all-test-names tabdat))
    (for-each ;;run
     (lambda (rundat)

       (if (or (not rundat) ;; handle padded runs
	       (not (dboard:rundat-run rundat)))
           ;; Need to put an empty column in to erase previous contents.
	   (set! rundat (dboard:rundat-make-init
			 key-vals: (map (lambda (x) "")(dboard:tabdat-keys tabdat)))))
       (let* ((run              (dboard:rundat-run rundat))
	      (testsdat-by-name (dboard:rundat-tests-by-name rundat))
	      (key-val-dat      (dboard:rundat-key-vals rundat))
	      (run-id           (db:get-value-by-header run (dboard:tabdat-header tabdat) "id"))
	      (key-vals         (append key-val-dat
					(list (let ((x (db:get-value-by-header run (dboard:tabdat-header tabdat) "runname")))
						(if (string? 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 (dboard:tabdat-buttondat tabdat) (mkstr coln rown) #f)))
		(if (and buttondat
			 (hash-table? testsdat-by-name))
		    (let* ((testdat      (let ((matching (hash-table-ref/default testsdat-by-name testname #f)))
					   ;; (filter 
					   ;;   (lambda (x)(equal? (test:test-get-fullname x) testname))
					   ;;     testsdat)))
					   (if (not matching)
					       (vector -1 -1 "" "" "" 0 "" "" 0 "" "" "" 0 "" "")
					       ;; (car matching))))
					       matching)))



			   (teststatus   (db:test-get-status     testdat))
			   (teststate    (db:test-get-state      testdat))


			   (buttontxt    (cond
					  ((member teststate '("COMPLETED" "ARCHIVED")) teststatus)
					  ((and (equal? teststate "NOT_STARTED")
						(member teststatus '("ZERO_ITEMS" "BLOCKED" "PREQ_FAIL" "PREQ_DISCARDED" "TIMED_OUT" "KEEP_TRYING" "TEN_STRIKES")))
					   teststatus)
					  (else
					   teststate)))
			   (button     (vector-ref columndat rown))
			   (color      (car (gutils:get-color-for-state-status teststate teststatus)))
			   (curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR"))
			   (curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE")))
		      (if (not (equal? curr-color color))
			  (if use-bgcolor
			      (iup:attribute-set! button "BGCOLOR" color)
			      (iup:attribute-set! button "IMAGE" (make-image *images* buttontxt color))))
		      (if (and (not use-bgcolor) ;; bgcolor does not work with text
			       (not (equal? curr-title buttontxt)))
			  (iup:attribute-set! button "TITLE" buttontxt))
		      (vector-set! buttondat 0 run-id)
		      (vector-set! buttondat 1 color)
		      (vector-set! buttondat 2 buttontxt)
		      (vector-set! buttondat 3 testdat)
		      (vector-set! buttondat 4 run-key)))
		(set! rown (+ rown 1))))
	    (dboard:tabdat-all-test-names tabdat)))

			    "190 190 190"
			    ))
    (dboard:tabdat-filters-changed-set! tabdat #t)))

(define (update-search commondat tabdat x val)
  (hash-table-set! (dboard:tabdat-searchpatts tabdat) x val)
  (dboard:tabdat-filters-changed-set! tabdat #t)
  (mark-for-update tabdat)
  (set-bg-on-filter commondat tabdat))

;; force ALL updates to zero (effectively)
;;
(define (mark-for-update tabdat)

  (dboard:tabdat-last-db-update-set! tabdat (make-hash-table)))

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

;; target populating logic
;;  

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

;; used by run-controls
;;
(define (dashboard:update-tree-selector tabdat #!key (action-proc #f))
  (let* ((tb            (dboard:tabdat-runs-tree tabdat))
	 (runconf-targs (common:get-runconfig-targets))
	 (db-target-dat (rmt:get-targets))
         (runs-tree-ht  (dboard:tabdat-runs-tree-ht tabdat))
	 (header        (vector-ref db-target-dat 0))
	 (db-targets    (vector-ref db-target-dat 1))
	 (munge-target  (lambda (x)            ;; create a target vector from a string. Pad with na if needed.
			  (take (append (string-split x "/")
					(make-list (length header) "na"))
				(length header))))
	 (all-targets   (append (list (munge-target (string-intersperse 
						     (map (lambda (x) "%") header)
						     "/")))
				(map vector->list db-targets)
				(map munge-target
				     runconf-targs)
				)))
    (for-each
     (lambda (target)
       (if (not (hash-table-ref/default runs-tree-ht target #f))
           ;; (let ((existing (tree:find-node tb target)))
           ;;   (if (not existing)
           (begin
             (tree:add-node tb "Runs" target) ;; (append key-vals (list run-name))
             (hash-table-set! runs-tree-ht target #t))))
     all-targets)))

;; Run controls panel
;;
(define (dashboard:run-controls commondat tabdat #!key (tab-num #f))
  (let* ((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")

	      #:value 200
	      ;; 
	     ;;       (iup:split
	     ;;        #:value 300

	     ;; Target, testpatt, state and status input boxes
	     ;;
	     (iup:split
	      #:orientation "HORIZONTAL"
	      (iup:vbox
	       ;; Command to run, placed over the top of the canvas
	       (dcommon:command-action-selector commondat tabdat tab-num: tab-num)
	       (dboard:runs-tree-browser commondat tabdat))
	      (iup:vbox
	       (dcommon:command-runname-selector commondat tabdat tab-num: tab-num)
	       (dcommon:command-testname-selector commondat tabdat update-keyvals)))
	     ;;  key-listboxes))
	     (dcommon:command-tests-tasks-canvas tabdat test-records sorted-testnames tests-draw-state))))
	   (tb (dboard:tabdat-runs-tree tabdat)))
      (dboard:commondat-add-updater 
       commondat 
       (lambda ()
         (if (dashboard:database-changed? commondat tabdat context-key: 'run-control)
             (dashboard:update-tree-selector tabdat)))
       tab-num: tab-num)
      result)))

 ;;(iup:frame
 ;; #:title "Logs" ;; To be replaced with tabs
 ;; (let ((logs-tb (iup:textbox #:expand "YES"
 ;;				   #:multiline "YES")))
 ;;	 (dboard:tabdat-logs-textbox-set! tabdat logs-tb)
 ;;	 logs-tb))

;; browse runs as a tree. Used in both "Runs" tab and
;; in the runs control panel.
;;
(define (dboard:runs-tree-browser commondat tabdat)
  (let* ((txtbox (iup:textbox
		  #:action (lambda (val a b)
			     (debug:catch-and-dump
			      (lambda ()
				;; for the Runs view we put the list
				;; of keyvals into tabdat target for
				;; the Run Controls we put then update
				;; the run-command
				(if b (dboard:tabdat-target-set! tabdat
								 (string-split b "/")))
				(dashboard:update-run-command tabdat))
			      "command-testname-selector tb action"))
		  #:value (dboard:test-patt->lines
			   (dboard:tabdat-test-patts-use tabdat))
		  #:expand "HORIZONTAL"
		  ;; #:size "10x30"
		  ))
	 (tb
          (iup:treebox
           #:value 0
           #:title "Runs"     ;;  was #:name -- iup 3.19 changed
			      ;;  this... "Changed: [DEPRECATED
			      ;;  REMOVED] removed the old attribute
			      ;;  NAMEid from IupTree to avoid
			      ;;  conflict with the common attribute
			      ;;  NAME. Use the TITLEid attribute."
           #:expand "YES"
           #:addexpanded "YES"
           #:size "10x"
           #:selection-cb
           (lambda (obj id state)
             (debug:catch-and-dump
              (lambda ()
                (let* ((run-path (tree:node->path obj id))
                       (run-id    (tree-path->run-id tabdat (cdr run-path))))
                  ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ??
                  ;; done below when run-id is a number
                  (dboard:tabdat-target-set! tabdat (cdr run-path)) ;; (print
								    ;; "run-path:
								    ;; "
								    ;; run-path)
		  (iup:attribute-set! txtbox "VALUE"
				      (string-intersperse (cdr run-path) "/"))
		  (dashboard:update-run-command tabdat)
                  (dboard:tabdat-layout-update-ok-set! tabdat #f)
                  (if (number? run-id)
                      (begin
                        ;; capture last two in tabdat.
                        (dboard:tabdat-prev-run-id-set!
                         tabdat
                         (dboard:tabdat-curr-run-id tabdat))
                        (dboard:tabdat-curr-run-id-set! tabdat run-id)
                        (dboard:tabdat-view-changed-set! tabdat #t))
                      (debug:print-error 5 *default-log-port* "tree-path->run-id returned non-number " run-id))))
              "treebox"))
           ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
           )))
    (dboard:tabdat-runs-tree-set! tabdat tb)
    (iup:detachbox
     (iup:vbox 
      txtbox
      tb
      ))))

;; browse runs as a tree. Used in both "Runs" tab and
;; in the runs control panel.
;;
;;  THIS IS THE NEW ONE
;;
(define (dboard:runs-tree-new-browser commondat rdat)
  (let* ((txtbox (iup:textbox
		  #:action (lambda (val a b)
			     (debug:catch-and-dump
			      (lambda ()
				;; for the Runs view we put the list
				;; of keyvals into tabdat target for
				;; the Run Controls we put then update
				;; the run-command
				(if b (dboard:rdat-targ-sql-filt-set! rdat
								 (string-split b "/")))
				#;(dashboard:update-run-command tabdat))
			      "command-testname-selector tb action"))
		  ;; #:value (dboard:test-patt->lines  ;; This seems like it was wrong, BUG in code where it was copied from?
	          ;;		   (dboard:tabdat-test-patts-use tabdat))
		  #:expand "HORIZONTAL"
		  ;; #:size "10x30"
		  ))
	 (tb
          (iup:treebox
           #:value 0
           #:title "Runs"     ;;  was #:name -- iup 3.19 changed
			      ;;  this... "Changed: [DEPRECATED
			      ;;  REMOVED] removed the old attribute
			      ;;  NAMEid from IupTree to avoid
			      ;;  conflict with the common attribute
			      ;;  NAME. Use the TITLEid attribute."
           #:expand "YES"
           #:addexpanded "YES"
           ;; #:size "10x"
           #:selection-cb
           (lambda (obj id state)
             (debug:catch-and-dump
              (lambda ()
                (let* ((run-path (tree:node->path obj id))
                       (run-id    (new-tree-path->run-id rdat (cdr run-path))))
                  ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ??
                  ;; done below when run-id is a number
                  (dboard:rdat-targ-sql-filt-set! rdat (cdr run-path)) ;; (print
								    ;; "run-path:
								    ;; "
								    ;; run-path)
		  (iup:attribute-set! txtbox "VALUE"
				      (string-intersperse (cdr run-path) "/"))
		  #;(dashboard:update-run-command tabdat)
                  #;(dboard:tabdat-layout-update-ok-set! tabdat #f)
                  (if (number? run-id)
                      (begin
                        ;; capture last two in tabdat.
                        (dboard:rdat-push-run-id rdat run-id)
			(dboard:rdat-view-changed-set! rdat #t))
                      (debug:print-error 5 *default-log-port* "tree-path->run-id returned non-number " run-id))))
              "treebox"))
           ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
           )))
    (dboard:rdat-runs-tree-set! rdat tb)
    (iup:detachbox
     (iup:vbox 
      txtbox
      tb
      ))))

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

	"Compact layout"
	#:fontsize 8
	#:expand "HORIZONTAL"
	#: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))
		      (dboard:tabdat-last-filter-str-set! tabdat "")
		      )
		    "text-list-toggle-box"))))
      (dcommon:command-runname-selector commondat tabdat tab-num: tab-num)
      (dcommon:command-testname-selector commondat tabdat update-keyvals))
     (iup:vbox
      (iup:split
       #:orientation "HORIZONTAL"
       #:value 800
      (let* ((cnv-obj (iup:canvas 
		       ;; #:size "250x250" ;; "500x400"
		       #:expand "YES"
		       #:scrollbar "YES"
		       #:posx "0.5"
		       #:posy "0.5"
		       #:action (make-canvas-action
				  (lambda (c xadj yadj)
				    (debug:catch-and-dump

					  (vg:drawing-scalex-set! drawing
								  (+ scalex
								     (if (> step 0)
									 (* scalex  0.02)
									 (* scalex -0.02))))))
				      "wheel-cb"))
		       )))
	cnv-obj)
      (let* ((hb1 (iup:hbox))
             (graph-cell-table (dboard:tabdat-graph-cell-table tabdat))
             (changed #f)
             (graph-matrix (iup:matrix
                           #:alignment1 "ALEFT"
                           ;; #:expand "YES" ;; "HORIZONTAL"
                           #:scrollbar "YES"
                           #:numcol 10
                           #:numlin 20
                           #:numcol-visible 5 ;; (min 8)
                           #:numlin-visible 1
                           #:click-cb
                           (lambda (obj row col status)
                             (let*
                                 ((graph-cell (conc row ":" col))
                                 (graph-dat   (hash-table-ref/default graph-cell-table graph-cell #f))
                                 (graph-flag  (dboard:graph-dat-flag graph-dat)))
                               (if graph-flag
                                   (dboard:graph-dat-flag-set! graph-dat #f)
                                   (dboard:graph-dat-flag-set! graph-dat #t))
                               (if (not (dboard:tabdat-running-layout tabdat))
						     (begin
						       (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num)
						       (dboard:tabdat-last-data-update-set! tabdat (current-seconds))
						       (thread-start! (make-thread
								       (lambda ()
									 (dboard:tabdat-running-layout-set! tabdat #t)
									 (dashboard:run-times-tab-layout-updater commondat tabdat tab-num)
									 (dboard:tabdat-running-layout-set! tabdat #f))
								       "run-times-tab-layout-updater"))))
                               ;;(dboard:tabdat-view-changed-set! tabdat #t)
                               )))))
        (dboard:tabdat-graph-matrix-set! tabdat graph-matrix)
        (iup:attribute-set! graph-matrix "WIDTH0" 0)
        (iup:attribute-set! graph-matrix "HEIGHT0" 0)
        graph-matrix))
      (iup:hbox
       (iup:vbox
        (iup:button "Show All" #:action (lambda (obj)
                                          (for-each (lambda (graph-cell)
                                                      (let* ((graph-dat   (hash-table-ref (dboard:tabdat-graph-cell-table tabdat) graph-cell)))
                                                        (dboard:graph-dat-flag-set! graph-dat #t)))
                                                    (hash-table-keys (dboard:tabdat-graph-cell-table tabdat))))))
       (iup:hbox
        (iup:button "Hide All" #:action (lambda (obj)
                                          (for-each (lambda (graph-cell)
                                                      (let* ((graph-dat   (hash-table-ref (dboard:tabdat-graph-cell-table tabdat) graph-cell)))
                                                        (dboard:graph-dat-flag-set! graph-dat #f)))
                                                    (hash-table-keys (dboard:tabdat-graph-cell-table tabdat)))))))
      ))))

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

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

(define (new-tree-path->run-id rdat path)
  (if (not (null? path))
      (hash-table-ref/default (dboard:rdat-path-run-ids tabdat) path #f)
      #f))

;; (define (dboard:get-tests-dat tabdat run-id last-update)
;;   (let* ((access-mode     (dboard:tabdat-access-mode tabdat))
;;          (tdat (if run-id (db:dispatch-query access-mode rmt:get-tests-for-run db:get-tests-for-run
;;                                              run-id 
;; 					     (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
;; 					     (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat))  ;; '()
;; 					     (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)) ;; '()
;; 					     #f #f                                                       ;; offset limit
;; 					     (dboard:tabdat-hide-not-hide tabdat)                        ;; not-in
;; 					     #f #f                                                       ;; sort-by sort-order
;; 					     #f ;; get all? "id,testname,item_path,state,status,event_time,run_duration"                        ;; qryval
;;                                              (if (dboard:tabdat-filters-changed tabdat)

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


(define (dashboard:safe-cadr-assoc name lst)
  (let ((res (assoc name lst)))
    (if (and res (> (length res) 1))
	(cadr res)
	#f)))

(define (dboard:update-tree tabdat runs-hash runs-header tb)
  (let* ((access-mode   (dboard:tabdat-access-mode tabdat))
         (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)))))
         (changed      #f)
	 (last-runs-update  (dboard:tabdat-last-runs-update tabdat))
	 (runs-dat     (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update)))
    (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
    (for-each (lambda (run-id)
		(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
		       (key-vals   (map (lambda (key)
                                          (let ((val (db:get-value-by-header run-record runs-header key)))
                                            (if (string? val) val "")))
					(dboard:tabdat-keys tabdat)))
		       (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))))
		  (if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f))
                      ;; (let ((existing   (tree:find-node tb run-path)))
                      ;;   (if (not existing)
                      (begin
                        (hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
                        ;; (iup:attribute-set! (dboard:tabdat-runs-matrix tabdat)
                        ;;    		 (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! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
                        ;; (set! colnum (+ colnum 1))
                        ))))
	      run-ids)))

(define (dashboard:tests-ht->tests-dat tests-ht)
  (reverse
   (sort
    (hash-table-values tests-ht)
    (lambda (a b) 
      (let ((a-test-name  (db:test-get-testname a))
            (a-item-path  (db:test-get-item-path a))
            (b-test-name  (db:test-get-testname b))
            (b-item-path  (db:test-get-item-path b))
            (a-event-time (db:test-get-event_time a))
            (b-event-time (db:test-get-event_time b)))
        (if (not (equal? a-test-name b-test-name))
            (> a-event-time b-event-time)
            (cond
             ((< 0 (string-compare3 a-test-name b-test-name)) #t)
             ((> 0 (string-compare3 a-test-name b-test-name)) #f)
             ((< 0 (string-compare3 a-item-path b-item-path)) #t)
             (else #f))))))))


(define (dashboard:run-id->tests-mindat run-id tabdat runs-hash)
  (let* ((run          (hash-table-ref/default runs-hash run-id #f))
         (key-vals     (rmt:get-key-vals run-id))
         (testnamepatt (or (dboard:tabdat-test-patts tabdat) "%/%"))
         (tests-ht     (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))
         (tests-dat    (dashboard:tests-ht->tests-dat tests-ht)) 
         (tests-mindat (dcommon:minimize-test-data tests-dat)))  ;; reduces data for display
    (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
    (hash-table-set! (dboard:tabdat-last-test-dat tabdat) run-id tests-dat)
    (hash-table-set! (dboard:tabdat-run-update-times tabdat) run-id (- (current-seconds) 10))
    (when (not run)
        (debug:print-info 13 *default-log-port* "ERROR: NO RUN FOR RUN-ID run-id="run-id)
        (debug:print-info 13 *default-log-port* "runs-hash-> " (hash-table->alist runs-hash))
        )
    tests-mindat))

(define (dashboard:runs-summary-xor-matrix-content tabdat runs-hash #!key (hide-clean #f))
  (let* ((src-run-id (dboard:tabdat-prev-run-id tabdat))
         (dest-run-id (dboard:tabdat-curr-run-id tabdat)))
    (if (and src-run-id dest-run-id)
        (dcommon:xor-tests-mindat 
         (dashboard:run-id->tests-mindat src-run-id tabdat runs-hash)
         (dashboard:run-id->tests-mindat dest-run-id tabdat runs-hash)
         hide-clean: hide-clean)
        #f)))


(define (dashboard:get-runs-hash tabdat) 
  (let* ((access-mode       (dboard:tabdat-access-mode tabdat))
         (last-runs-update  0);;(dboard:tabdat-last-runs-update tabdat))
	 (runs-dat     (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))
	 (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
         (runs         (vector-ref runs-dat 1))
	 (run-id       (dboard:tabdat-curr-run-id tabdat))
         (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))
				   runs) ht)))
    runs-hash))
         

(define (dashboard:runs-summary-updater commondat tabdat tb cell-lookup run-matrix)
  ;; (if (dashboard:database-changed? commondat tabdat context-key: 'runs-summary-rundat)
  (dashboard:do-update-rundat tabdat) ;; )
  (dboard:runs-summary-control-panel-updater tabdat)
  (let* ((last-runs-update  (dboard:tabdat-last-runs-update tabdat))
	 (runs-dat     (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))
	 (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
         (runs         (vector-ref runs-dat 1))
	 (run-id       (dboard:tabdat-curr-run-id tabdat))
         (runs-hash (dashboard:get-runs-hash tabdat))
         ;; (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))
	 ;;        		   runs)
	 ;;        	 ht))
         )
    (if (dashboard:database-changed? commondat tabdat context-key: 'runs-summary-tree)
        (dboard:update-tree tabdat runs-hash runs-header tb))
    (if run-id
        (let* ((matrix-content





                (case (dboard:tabdat-runs-summary-mode tabdat) 

                  ((one-run) (dashboard:run-id->tests-mindat run-id tabdat runs-hash))



                  ((xor-two-runs) (dashboard:runs-summary-xor-matrix-content tabdat runs-hash))

                  ((xor-two-runs-hide-clean) (dashboard:runs-summary-xor-matrix-content tabdat runs-hash hide-clean: #t))
                  (else (dashboard:run-id->tests-mindat run-id tabdat runs-hash)))))
          (when matrix-content
            (let* ((indices      (common:sparse-list-generate-index matrix-content)) ;;  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 (- (dboard:tabdat-num-tests tabdat) 15) 3)) ;; (dboard:tabdat-num-tests tabdat) is proportional to the size of the window
                   (numrows      1)
                   (numcols      1)
                   (changed      #f)
                   )
              


              (dboard:tabdat-filters-changed-set! tabdat #f)
              (let loop ((pass-num 0)
                         (changed  #f))
                ;; Update the runs tree
                ;; (dboard:update-tree tabdat runs-hash runs-header tb)
                
                (if (eq? pass-num 1)
                    (begin ;; big reset
                      (iup:attribute-set! run-matrix "CLEARVALUE" "ALL") ;; NOTE: Was CONTENTS
                      (iup:attribute-set! run-matrix "CLEARATTRIB" "CONTENTS")
                      (iup:attribute-set! run-matrix "RESIZEMATRIX" "YES")))

                (if (> max-col (string->number (iup:attribute run-matrix "NUMCOL")))
                    (iup:attribute-set! run-matrix "NUMCOL" max-col ))

                (let ((effective-max-row (if (< max-row max-visible) max-visible max-row)))
                  (if (> effective-max-row (string->number (iup:attribute run-matrix "NUMLIN")))
                      (iup:attribute-set! run-matrix "NUMLIN" effective-max-row )))
                
                ;; Row labels
                (for-each (lambda (ind)
                            (let* ((name (car ind))
                                   (num  (cadr ind))
                                   (key  (conc num ":0")))
                              (if (not (equal? (iup:attribute run-matrix key) name))
                                  (begin
                                    (set! changed #t)
                                    (iup:attribute-set! run-matrix key name)))))
                          row-indices)
                ;; (print "row-indices: " row-indices " col-indices: " col-indices)
                (if (and (eq? pass-num 0) changed)
                    (loop 1 #t)) ;; force second pass
                
                ;; Cell contents
                (for-each (lambda (entry)
                            ;; (print "entry: " entry)
                            (let* ((row-name  (cadr entry))
                                   (col-name  (car entry))
                                   (valuedat  (caddr entry))
                                   (test-id   (list-ref valuedat 0))
                                   (test-name row-name) ;; (list-ref valuedat 1))
                                   (item-path col-name) ;; (list-ref valuedat 2))
                                   (state     (list-ref valuedat 1))
                                   (status    (list-ref valuedat 2))
                                   (value     (gutils:get-color-for-state-status state status))
                                   (row-num   (cadr (assoc row-name row-indices)))
                                   (col-num   (cadr (assoc col-name col-indices)))
                                   (key       (conc row-num ":" col-num)))
                              (hash-table-set! cell-lookup key test-id)
                              (if (not (equal? (iup:attribute run-matrix key) (cadr value)))
                                  (begin
                                    (set! changed #t)
                                    (iup:attribute-set! run-matrix key (cadr value))
                                    (iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value))))))
                          matrix-content)
                
                ;; Col labels - do after setting Cell contents so they are accounted for in the size calc.
                
                (for-each (lambda (ind)
                            (let* ((name (car ind))
                                   (num  (cadr ind))
                                   (key  (conc "0:" num)))
                              (if (not (equal? (iup:attribute run-matrix key) name))
                                  (begin
                                    (set! changed #t)
                                    (iup:attribute-set! run-matrix key name)
                                    (if (<= num max-col)
                                        (iup:attribute-set! run-matrix "FITTOTEXT" (conc "C" num)))))))
                          col-indices)
                
                (if (and (eq? pass-num 0) changed)
                    (loop 1 #t)) ;; force second pass due to column labels changing
                
                ;; (debug:print 0 *default-log-port* "runs-summary-updater, changed: " changed " pass-num: " pass-num)
                ;; (print "runs-summary-updater, changed: " changed " pass-num: " pass-num)
                (if changed (iup:attribute-set! run-matrix "REDRAW" "ALL")))))))))



;;======================================================================
;; S U M M A R Y 
;;======================================================================
;;
;; General info about the run(s) and megatest area
(define (dashboard:summary commondat tabdat #!key (tab-num #f))
  (let* ((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)))
	 (changed          #f))
    (iup:vbox
     (iup:split
      #:value 300
      (iup:frame 
       #:title "General Info"
       (iup:vbox
	(iup:hbox
	 (iup:label "Area Path")
	 (iup:textbox #:value *toppath* #:expand "HORIZONTAL"))
	(iup:hbox 

(define (dboard:add-external-tab commondat view-name views-cfgdat tabs tab-num)
  (let* ((success #t) ;; at any stage of the process set this flag to #f to skip downstream steps. Intention here is to recover gracefully if user provided tabs fail to load.
	 (source  (configf:lookup views-cfgdat view-name "source"))
	 (viewgen (configf:lookup views-cfgdat view-name "viewgen"))
	 (updater (configf:lookup views-cfgdat view-name "updater"))
	 (result-child #f))
    (if (and (common:file-exists? source)
	     (file-read-access? source))
	(handle-exceptions
	 exn
	 (begin
	   (print-call-chain)
	   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
	   (debug:print 0 *default-log-port* "ERROR: failed to load " source ", try loading in the repl: megatest -repl")
	   (set! success #f))
	 (load source))
	(begin
	  (debug:print 0 *default-log-port* "ERROR: cannot find file to load: \"" source "\" for user view " view-name)))
    ;; now run the user supplied definition for the tab view
    (if success
	(handle-exceptions
	 exn
	 (begin
	   (print-call-chain)
	   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
	   (debug:print 0 *default-log-port* "ERROR: failed call procedure " viewgen
			", with; tab-num=" tab-num ", view-name=" view-name
			", and views-cfgdat and megatest configdat as parameters. To debug try loading in the repl: megatest -repl")
	   (set! success #f))
	 (debug:print 0 *default-log-port* "Adding tab " view-name " with proc " viewgen)
	 ;; (iup:child-add! tabs
	 (set! result-child 
	       ((eval (string->symbol viewgen)) commondat tabs tab-num view-name views-cfgdat *configdat*))))
    ;; and finally set the updater
    (if success
	(dboard:commondat-add-updater commondat
				      (lambda ()
					(handle-exceptions
					 exn
					 (begin
					   (print-call-chain)
					   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
					   (debug:print 0 *default-log-port* "ERROR: failed call procedure \"" updater
							"\", with; tabnum=" tab-num ", view-name=" view-name
							", and views-cfgdat and megatest configdat as parameters. To debug try loading in the repl: megatest -repl")
					   (set! success #f))
					 (debug:print 4 *default-log-port* "Running updater for tab " view-name " with proc " updater " and tab-num: " tab-num)
					 ((eval (string->symbol updater)) commondat tabs tab-num view-name views-cfgdat *configdat*)))
				      tab-num: tab-num))
    ;;(if success
    ;;	(begin
    ;;	  ;; (iup:attribute-set! tabs (conc "TABTITLE" tab-num) view-name)
    ;;	  (dboard:common-set-tabdat! commondat tab-num (dboard:tabdat-make-data))))
    result-child))



(define (dboard:runs-summary-buttons-updater tabdat)
  (let loop ((buttons-left (dboard:tabdat-runs-summary-mode-buttons tabdat))
             (modes-left (dboard:tabdat-runs-summary-modes tabdat)))
    (if (or (null? buttons-left) (null? modes-left))
        #t
        (let* ((this-button (car buttons-left))
               (mode-item (car modes-left))
               (this-mode (car mode-item))
               (sel-color    "180 100 100")
               (nonsel-color "170 170 170")
               (current-mode (dboard:tabdat-runs-summary-mode tabdat)))
          (if (eq? this-mode current-mode)
              (iup:attribute-set! this-button "BGCOLOR" sel-color)
              (iup:attribute-set! this-button "BGCOLOR" nonsel-color))
          (loop (cdr buttons-left) (cdr modes-left))))))

(define (dboard:runs-summary-xor-labels-updater tabdat)
  (let ((source-runname-label (dboard:tabdat-runs-summary-source-runname-label tabdat))
        (dest-runname-label (dboard:tabdat-runs-summary-dest-runname-label tabdat))
        (mode (dboard:tabdat-runs-summary-mode tabdat)))
    (when (and source-runname-label dest-runname-label)
      (case mode
        ((xor-two-runs xor-two-runs-hide-clean)
         (let* ((curr-run-id          (dboard:tabdat-curr-run-id tabdat))
                (prev-run-id          (dboard:tabdat-prev-run-id tabdat))
                (curr-runname (if curr-run-id
                                  (rmt:get-run-name-from-id curr-run-id)
                                  "None"))
                (prev-runname (if prev-run-id
                                  (rmt:get-run-name-from-id prev-run-id)
                                  "None")))
           (iup:attribute-set! source-runname-label "TITLE" (conc " SRC: "prev-runname"  "))
           (iup:attribute-set! dest-runname-label "TITLE" (conc "DEST: "curr-runname"  "))))
        (else
         (iup:attribute-set! source-runname-label "TITLE" "")
         (iup:attribute-set! dest-runname-label "TITLE" ""))))))

(define (dboard:runs-summary-control-panel-updater tabdat)
  (dboard:runs-summary-xor-labels-updater tabdat)
  (dboard:runs-summary-buttons-updater tabdat))


;; setup buttons and callbacks to switch between modes in runs summary tab
;;
(define (dashboard:runs-summary-control-panel tabdat)
  (let* ((summary-buttons ;; build buttons
          (map
           (lambda (mode-item)
             (let* ((this-mode (car mode-item))
                    (this-mode-label (cdr mode-item)))
               (iup:button this-mode-label
                           #:action
                           (lambda (obj)
                             (debug:catch-and-dump
                              (lambda ()
                                (dboard:tabdat-runs-summary-mode-set! tabdat this-mode)
                                (dboard:runs-summary-control-panel-updater tabdat))
                              "runs summary control panel updater")))))
           (dboard:tabdat-runs-summary-modes tabdat)))
         (summary-buttons-hbox (apply iup:hbox summary-buttons))
         (xor-runname-labels-hbox
          (iup:hbox
           (let ((temp-label
                  (iup:label "" #:size "125x15" #:fontsize "10" )))
             (dboard:tabdat-runs-summary-source-runname-label-set! tabdat temp-label)
             temp-label
             )
           (let ((temp-label
                  (iup:label "" #:size "125x15" #:fontsize "10")))
             (dboard:tabdat-runs-summary-dest-runname-label-set! tabdat temp-label)
             temp-label))))
    (dboard:tabdat-runs-summary-mode-buttons-set! tabdat summary-buttons)

    ;; maybe wrap in a frame
    (let ((res (iup:vbox summary-buttons-hbox xor-runname-labels-hbox )))
      (dboard:runs-summary-control-panel-updater tabdat)
      res
      )))



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

;; This is the Run Summary tab
;; 
(define (dashboard:runs-summary commondat tabdat #!key (tab-num #f))
  (let* ((update-mutex (dboard:commondat-update-mutex commondat))
	 (tb      (iup:treebox
		   #:value 0
		   ;;#:name "Runs"
                   #:title "Runs"
		   #:expand "YES"
		   #:addexpanded "YES"
		   #:selection-cb
		   (lambda (obj id state)
		     (debug:catch-and-dump
		      (lambda ()
			;; (print "obj: " obj ", id: " id ", state: " state)
			(let* ((run-path (tree:node->path obj id))
			       (run-id   (tree-path->run-id tabdat (cdr run-path))))
			  (if (number? run-id)
			      (begin
                                (dboard:tabdat-prev-run-id-set!
                                 tabdat
                                 (dboard:tabdat-curr-run-id tabdat))

				(dboard:tabdat-curr-run-id-set! tabdat run-id)
				(dboard:tabdat-layout-update-ok-set! tabdat #f)
				;; (dashboard:update-run-summary-tab)
				)
			      ;; (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id)
			      )))
		      "selection-cb in runs-summary")
		     ;; (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)
                        (debug:catch-and-dump
                         (lambda ()

                           ;; Bummer - we dont have the global get/set api mapped in chicken
                           ;; (let* ((modkeys (iup:global "MODKEYSTATE")))
                           ;;   (BB> "modkeys="modkeys))

                           (debug:print-info 13 *default-log-port* "click-cb: obj="obj" lin="lin" col="col" status="status)
                           ;; status is corrupted on Brandon's home machine.  will have to wait until after shutdown to see if it is still broken in PDX SLES
                           (let* ((toolpath (car (argv)))
                                  (key      (conc lin ":" col))
                                  (test-id   (hash-table-ref/default cell-lookup key -1))
                                  (run-id   (dboard:tabdat-curr-run-id tabdat))
                                  (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-info  (rmt:get-test-info-by-id run-id test-id))
                                  (test-name (db:test-get-testname test-info))
                                  (testpatt  (let ((tlast (rmt:tasks-get-last target runname)))
                                                (if tlast
                                                    (let ((tpatt (tasks:task-get-testpatt tlast)))
                                                      (if (member tpatt '("0" 0)) ;; known bad historical value - remove in 2017
                                                          "%"
                                                          tpatt))
                                                    "%")))
                                  (item-path (db:test-get-item-path (rmt:get-test-info-by-id run-id test-id)))
                                  (item-test-path (conc test-name "/" (if (equal? item-path "")
									"%" 
									item-path)))
                                  (status-chars (char-set->list (string->char-set status)))
                                  (run-id       (dboard:tabdat-curr-run-id tabdat)))
                             (debug:print-info 13 *default-log-port* "status-chars=["status-chars"] status=["status"]")
                             (cond
                              ((member #\1 status-chars) ;; 1 is left mouse button
                               (dboard:launch-testpanel run-id test-id))
                              
                              ((member #\2 status-chars) ;; 2 is middle mouse button
                               
                               (debug:print-info 13 *default-log-port* "mmb- test-name="test-name" testpatt="testpatt)
                               (iup:show (dashboard:context-menu run-id test-id target runname test-name testpatt item-test-path test-info) ;; popup-menu
                                         #:x 'mouse
                                         #:y 'mouse
                                         #:modal? "NO")
                               )
                              (else
                               (debug:print-info 13 *default-log-port* "unhandled status in run-summary-click-cb.  Doing right click action. (status is corrupted on Brandon's ubuntu host - bad/buggy  iup install??" )
                               (iup:show (dashboard:context-menu run-id test-id target runname test-name testpatt item-test-path test-info) ;; popup-menu
                                         #:x 'mouse
                                         #:y 'mouse
                                         #:modal? "NO")
                               )
                              )
                            
                             )) "runs-summary-click-callback"))))
	 (runs-summary-updater  
          (lambda ()
	    ;; (mutex-lock! update-mutex)
            (if  (or (dashboard:database-changed? commondat tabdat context-key: 'runs-summary-updater)
                     (dboard:tabdat-view-changed tabdat))
                 (debug:catch-and-dump
                  (lambda () ;; check that run-matrix is initialized before calling the updater
		    (if run-matrix 
			(dashboard:runs-summary-updater commondat tabdat tb cell-lookup run-matrix)))
                  "dashboard:runs-summary-updater")
                 )
	    #;(mutex-unlock! update-mutex)
	    ))
         (runs-summary-control-panel (dashboard:runs-summary-control-panel tabdat))
         )
    (dboard:commondat-add-updater commondat runs-summary-updater tab-num: tab-num)
    (dboard:tabdat-runs-tree-set! tabdat tb)
    (iup:vbox
     (iup:split
      #:value 200
      tb
      run-matrix)
     (dboard:make-controls commondat tabdat extra-widget: runs-summary-control-panel))))

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

(define (dboard:squarify toggles size)
  (let loop ((hed (car toggles))
	     (tal (cdr toggles))
	     (cur '())
	     (res '()))
    (let* ((ovrflo (>= (length cur) size))
	   (newcur (if ovrflo
		       (list hed)
		       (cons hed cur)))
	   (newres (if ovrflo
		       (cons cur res)
		       res)))
      (if (null? tal)
	  (if ovrflo
	      newres
	      (cons newcur res))
	  (loop (car tal)(cdr tal) newcur newres)))))

(define (dboard:make-controls commondat tabdat #!key (extra-widget #f) )
  (let ((btn-fontsz  (dboard:tabdat-runs-btn-fontsz tabdat)))
    (iup:hbox
     (iup:vbox
      (iup:frame 
       #:title "filter test and items"
       (iup:vbox
        (iup:hbox
	(iup:vbox
	 (iup:textbox #:size "120x15" #:fontsize "10" #:value "%"
		      #:expand "NO"
		      #:action (lambda (obj unk val)
				 (debug:catch-and-dump
				  (lambda ()57
				    (mark-for-update tabdat)
				    (update-search commondat tabdat "test-name" val))
				  "make-controls")))
	 (iup:hbox
	  (iup:button "Quit"      #:action (lambda (obj)

					     (exit))
		      #:expand "NO" #:size "40x15")
	  (iup:button "Refresh"   #:action (lambda (obj)
                                             (dboard:tabdat-last-data-update-set! tabdat 0)
                                             (dboard:tabdat-last-runs-update-set! tabdat 0)
                                             (dboard:tabdat-run-update-times-set! tabdat (make-hash-table))
                                             (dboard:tabdat-last-test-dat-set!    tabdat (make-hash-table))
                                             (dboard:tabdat-allruns-set!          tabdat '())
                                             (dboard:tabdat-allruns-by-id-set!    tabdat (make-hash-table))
                                             (dboard:tabdat-done-runs-set!        tabdat '())
                                             (dboard:tabdat-not-done-runs-set!    tabdat '())
                                             (dboard:tabdat-view-changed-set!     tabdat #t)
                                             (dboard:commondat-please-update-set! commondat #t)
					     (dboard:clear-run-id-update-hash)
					     (mark-for-update tabdat))
		      #:expand "NO" #:size "40x15")
	  (iup:button "Collapse"  #:action (lambda (obj)
					     (debug:catch-and-dump 
					      (lambda ()
						(let ((myname (iup:attribute obj "TITLE")))
						  (if (equal? myname "Collapse")

		(sort-lb    (iup:listbox #:expand "NO" ;; "HORIZONTAL"
					 #:size   "80x15"
					 #:dropdown "YES"
					 #:action (lambda (obj val index lbstate)
						    (set! *tests-sort-reverse* index)
						    (mark-for-update tabdat))))
		(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 HORIZONTAL"
	   ;; 				#:expand "NO" #:size "80x15"
	   ;; 				#:action (lambda (obj)
	   ;; 					   (dboard:tabdat-hide-empty-runs-set! tabdat (not (dboard:tabdat-hide-empty-runs tabdat)))
	   ;; 					   (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-empty-runs tabdat) "+HideE" "-HideE"))
	   ;; 					   (mark-for-update tabdat))))
	   (set! hide (iup:button "Hide"
				  #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL"
				  #:action (lambda (obj)
					     (dboard:tabdat-hide-not-hide-set! tabdat #t) ;; (not (dboard:tabdat-hide-not-hide tabdat)))
					     ;; (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-not-hide tabdat) "HideTests" "NotHide"))
					     (iup:attribute-set! hide "BGCOLOR" sel-color)
					     (iup:attribute-set! show "BGCOLOR" nonsel-color)
					     (mark-for-update tabdat))))
	   (set! show (iup:button "Show"
				  #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL"
				  #:action (lambda (obj)
					     (dboard:tabdat-hide-not-hide-set! tabdat #f) ;; (not (dboard:tabdat-hide-not-hide tabdat)))
					     (iup:attribute-set! show "BGCOLOR" sel-color)
					     (iup:attribute-set! hide "BGCOLOR" nonsel-color)
					     (mark-for-update tabdat))))
	   (iup:attribute-set! hide "BGCOLOR" sel-color)
	   (iup:attribute-set! show "BGCOLOR" nonsel-color)
	   ;; (dboard:tabdat-hide-not-hide-button-set! tabdat hideit) ;; never used, can eliminate ...
           (iup:vbox
            (iup:hbox hide show)
            sort-lb))) 
	)

        ;; insert extra widget here
        (if extra-widget
            extra-widget
            (iup:hbox)) ;; empty widget

        

        
        )))

     (let* ((status-toggles (map (lambda (status)
				   (iup:toggle (conc status)
					       #:fontsize 8 ;; btn-fontsz ;; "10"
					       ;; #:expand "HORIZONTAL"
					       #:action   (lambda (obj val)
							    (mark-for-update tabdat)
							    (if (eq? val 1)
								(hash-table-set! (dboard:tabdat-status-ignore-hash tabdat) status #t)
								(hash-table-delete! (dboard:tabdat-status-ignore-hash tabdat) status))
							    (set-bg-on-filter commondat tabdat))))
				 (map cadr *common:std-statuses*))) ;; '("PASS" "FAIL" "WARN" "CHECK" "WAIVED" "STUCK/DEAD" "n/a" "SKIP")))


	    (state-toggles  (map (lambda (state)
				   (iup:toggle (conc state)
					       #:fontsize 8 ;; btn-fontsz
					       ;; #:expand "HORIZONTAL"
					       #:action   (lambda (obj val)
							    (mark-for-update tabdat)
							    (if (eq? val 1)
								(hash-table-set! (dboard:tabdat-state-ignore-hash tabdat) state #t)
								(hash-table-delete! (dboard:tabdat-state-ignore-hash tabdat) state))
							    (set-bg-on-filter commondat tabdat))))
				 (map cadr *common:std-states*))) ;; '("RUNNING" "COMPLETED" "INCOMPLETE" "LAUNCHED" "NOT_STARTED" "KILLED" "DELETED")))
	    (num-toggle-cols (inexact->exact (round (/ (max (length status-toggles)(length state-toggles)) 3)))))
       (iup:vbox
	(iup:hbox
	 (iup:frame
	  #:title "states"
	  (apply
	   iup:hbox
	   (map (lambda (colgrp)
		  (apply iup:vbox colgrp))
		(dboard:squarify state-toggles 3))))
	 (iup:frame
	  #:title "statuses"
	  (apply
	   iup:hbox
	   (map (lambda (colgrp)
		  (apply iup:vbox colgrp))
		(dboard:squarify status-toggles 3)))))
	;; 
	;; (iup:frame 
	;; 	#:title "state/status filter"
	;; 	(iup:vbox
	;; 	 (apply
	;; 	  iup:hbox
	;; 	  (map
	;; 	   (lambda (status-toggle state-toggle)
	;; 	     (iup:vbox
	;; 	      status-toggle
	;; 	      state-toggle))
	;; 	   status-toggles state-toggles))

	;; horizontal slider was here
	
	)))))

(define (dashboard:runs-horizontal-slider tabdat )
  (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  (dboard:tabdat-tot-runs tabdat)))
				      (dboard:tabdat-start-run-offset-set! tabdat val)
				      (mark-for-update tabdat)
				      (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
				      (iup:attribute-set! obj "MAX" (* maxruns 10))))
		#:expand "HORIZONTAL"
		#:max (* 10 (max (hash-table-size (dboard:tabdat-allruns-by-id tabdat)) 10))
		#:min 0
		#:step 0.01))




;; make-simple-run                   procedure (target3772 id3773 runname3774 state3775 status3776 owner3777 event_time3778)
;; rmt:simple-get-runs               procedure (runpatt1001 count1002 offset1003 target1004)
;; simple-run-event_time             procedure (x3834)
;; simple-run-event_time-set!        procedure (x3830 val3831)
;; simple-run-id                     procedure (x3794)
;; simple-run-id-set!                procedure (x3790 val3791)
;; simple-run-owner                  procedure (x3826)
;; simple-run-owner-set!             procedure (x3822 val3823)
;; simple-run-runname                procedure (x3802)
;; simple-run-runname-set!           procedure (x3798 val3799)
;; simple-run-state                  procedure (x3810)
;; simple-run-state-set!             procedure (x3806 val3807)
;; simple-run-status                 procedure (x3818)
;; simple-run-status-set!            procedure (x3814 val3815)
;; simple-run-target                 procedure (x3786)
;; simple-run-target-set!            procedure (x3782 val3783)
;; simple-run?                       procedure (x3780)



;;======================================================================
;; Extracting the data to display for runs
;;
;; This needs to be re-entrant such that it does one column per call
;; on the zeroeth call update runs data
;; on each subsequent call update one run (configurable - could do two, three ... or update until tdelta exceeded
;; on last run reset to zeroeth
;;
;;   1. select with run filters; area, target, runname, runstate, runstatus, starttime, duration
;;       - put this information into two data structures:
;;         a. hash of area/target/runname => runstruct #< ordernun, id, area, target, runname, state,
;;                                                        status, starttime, duration, non-deleted testcount>
;;            ordernum reflects order as received from sql query
;;         b. sparsevec of id => runstruct
;;   2. for each run in runshash ordered by ordernum do:
;;         retrieve data since last update for that run
;;         if there is a deleted test - retrieve full data
;;         if there are non-deleted tests register this run in the columns sparsevec
;;         if this is the zeroeth column regenerate the rows sparsevec
;;         if this column is in the visible zone update visible cells
;;
;; Other factors:

;;   1. left index handling:
;;       - add test/itempaths to left index as discovered, re-order and
;;         update row -> test/itempath mapping on each read run
;;======================================================================

;; runs is <vec header runs>
;;   get ALL runs info

;;   update rdat-targ-run-id
;;   update rdat-runs
;;
(define (dashboard:update-runs-data rdat)
  (let* ((tb               (dboard:rdat-runs-tree rdat))
	 (targ-sql-filt    (dboard:rdat-targ-sql-filt    rdat))
	 (runname-sql-filt (dboard:rdat-runname-sql-filt rdat))
	 (state-sql-filt   (dboard:rdat-run-state-sql-filt   rdat))
	 (status-sql-filt  (dboard:rdat-run-status-sql-filt  rdat))
	 ;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
	 (data             (rmt:simple-get-runs runname-sql-filt #f #f targ-sql-filt #f))
	 (numruns          (length data)))
    ;; store in the runsbynum vector
    (dboard:rdat-runsbynum-set! rdat (list->vector data))
    ;; update runs       id              => runrec
    ;; update targ-runid target/runname  => run-id
    (for-each
     (lambda (runrec)
       (let* ((run-id (simple-run-id runrec))
	      (full-targ-runname (conc (simple-run-target runrec) "/"
				       (simple-run-runname runrec))))
	 (debug:print 0 *default-log-port* "Update run  " run-id)
	 (sparse-vector-set! (dboard:rdat-runs rdat) run-id runrec)
	 (hash-table-set! (dboard:rdat-targ-runid rdat) full-targ-runname run-id)
	 ))






     data)


    numruns))

;; NOTE: runnum is NOT the run-id, it is a pointer into the runsbynum vector

;;
(define (dashboard:update-run-data runnum rdat)
  (let* ((curr-time            (current-seconds))
	 (runrec               (vector-ref (dboard:rdat-runsbynum rdat) runnum))
	 (run-id               (simple-run-id runrec))
	 (last-update          (sparse-vector-ref (dboard:rdat-last-updates rdat) run-id))
	 ;; filters
	 (testname-sql-filt    (dboard:rdat-testname-sql-filt    rdat))
	 ;; (itempath-sql-filt    (dboard:rdat-itempath-sql-filt    rdat))
	 (test-state-sql-filt  (dboard:rdat-test-state-sql-filt  rdat))  ;; not used yet
	 (test-status-sql-filt (dboard:rdat-test-status-sql-filt rdat))  ;; not used yet
	 (tests                (rmt:get-tests-for-run-state-status run-id
						      testname-sql-filt

						      last-update                ;; last-update
						      )))
    (sparse-vector-set! (dboard:rdat-last-updates rdat) run-id (- curr-time 1))
    (debug:print 0 *default-log-port* "Got " (length tests) " tests for run-id "
		 run-id " testname-sql-filt " testname-sql-filt " and last-update " last-update) 
    (length tests)))



(define (new-runs-updater commondat rdat)
  (let* ((runnum           (dboard:rdat-runnum          rdat))
	 (start-time       (current-milliseconds))
	 (tot-runs         #f))
    (if (eq? runnum 0)(dashboard:update-runs-data rdat))
    (set! tot-runs (vector-length (dboard:rdat-runsbynum rdat)))
    (let loop ((rn   runnum))
      (if (and (< (- (current-milliseconds) start-time) 250)
	       (< rn tot-runs))


	  (let* ((newrn (if (>= runnum (vector-length (dboard:rdat-runsbynum rdat)))
			    0 ;; start over

			    (+ rn 1)))) ;; (+ runnum 1)))
	    (dashboard:update-run-data rn rdat)
	    (dboard:rdat-runnum-set! rdat newrn)
	    (if (> newrn 0)


		(loop newrn)))))
    (if (>=  (dboard:rdat-runnum rdat) tot-runs)
	(dboard:rdat-runnum-set! rdat 0))
    ;; (dboard:rdat-runnum-set! rdat rn))) ;; not needed as it is set above
    ;; (dboard:rdat-last-update-set! rdat (- (current-seconds) 10))
    ;;    	 (tree:add-node tb "Runs" (string-split full-targ-runname "/"))
    '()))

(define (dboard:runs-new-matrix commondat rdat)
  (iup:matrix
   #:alignment1 "ALEFT"
   ;; #:expand "YES" ;; "HORIZONTAL"
   #:scrollbar "YES"
   #:numcol 10
   #:numlin 20
   #:numcol-visible 5 ;; (min 8)
   #:numlin-visible 1
   #:click-cb
   (lambda (obj row col status)
     (let* ((cell (conc row ":" col)))
       #f))
   ))
	 






(define (make-runs-view commondat rdat tab-num)
  ;; register an updater
  (dboard:commondat-add-updater
   commondat
   (lambda ()
     (new-runs-updater commondat rdat))
   tab-num: tab-num)

  (iup:vbox
   (iup:split
    #:orientation "VERTICAL" ;; "HORIZONTAL"
    #:value 100
    (dboard:runs-tree-new-browser commondat rdat)
    (dboard:runs-new-matrix commondat rdat)
    )))

(define (make-dashboard-buttons commondat) ;;  runs-sum-dat new-view-dat)
  (let* (
         (stats-dat       (dboard:tabdat-make-data))
	 (runs-dat        (dboard:tabdat-make-data))
	 (runs2-dat       (make-dboard:rdat)) ;; (dboard:tabdat-make-data))
	 (onerun-dat      (dboard:tabdat-make-data)) ;; name for run-summary structure 
	 (runcontrols-dat (dboard:tabdat-make-data))
	 (runtimes-dat    (dboard:tabdat-make-data))
	 (nruns           (dboard:tabdat-numruns runs-dat))
	 (ntests          (dboard:tabdat-num-tests runs-dat))
	 (keynames        (dboard:tabdat-dbkeys runs-dat))
	 (nkeys           (length keynames))
	 (runsvec         (make-vector nruns))
	 (header          (make-vector nruns))
	 (lftcol          (make-vector ntests))
	 (keycol          (make-vector ntests))
	 (controls        (dboard:make-controls commondat runs-dat)) ;; '())
	 (lftlst          '())
	 (hdrlst          '())
	 (bdylst          '())
	 (result          '())
	 (i               0)
	 (btn-height      (dboard:tabdat-runs-btn-height runs-dat))
	 (btn-fontsz      (dboard:tabdat-runs-btn-fontsz runs-dat))
	 (cell-width      (dboard:tabdat-runs-cell-width runs-dat))
	 (use-bgcolor     (equal? (configf:lookup *configdat* "dashboard" "use-bgcolor") "yes")))
    ;; controls (along bottom)
    ;; (set! controls (dboard:make-controls commondat runs-dat))
   


    ;; 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 (conc 40 btn-height)
						      #:fontsize btn-fontsz
						      #:expand "NO") ;; "HORIZONTAL")
					   (iup:textbox
					    #:size (conc 35 btn-height)
					    #:fontsize btn-fontsz
					    #:value "%"
					    #:expand "NO" ;; "HORIZONTAL"
					    #:action (lambda (obj unk val)
						       ;; each field
						       ;; (field name is "x" var) live updates
						       ;; the search filter as it is typed
						       (dboard:tabdat-target-set! runs-dat #f)
						       ;; ensure fields text boxes are used
						       ;; and not the info from the tree
						       (mark-for-update runs-dat)
						       (update-search commondat runs-dat 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 (dboard:tabdat-all-test-names runs-dat)))))
		      (dboard:commondat-please-update-set! commondat #t)
		      (dboard:tabdat-start-test-offset-set! runs-dat
							    (inexact->exact (round (/ val 10))))
		      (debug:print 6 *default-log-port*
				   "(dboard:tabdat-start-test-offset runs-dat) "
				   (dboard:tabdat-start-test-offset runs-dat) " 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
		      "" ;; the testname labels
		      #:flat "YES" 
		      #:alignment "ALEFT"
					; #:image img1
					; #:impress img2
		      #:size  (conc cell-width btn-height)
		      #:expand  "HORIZONTAL"
		      #:fontsize btn-fontsz
		      #:action (lambda (obj)
				 (mark-for-update runs-dat)
				 (toggle-hide testnum (dboard:commondat-uidat commondat)))))) 
	  (vector-set! lftcol testnum labl)
	  (loop (+ testnum 1)(cons labl res))))))
    ;; These are the headers for each row
    (let loop ((runnum  0)
	       (keynum  0)
	       (keyvec  (make-vector nkeys))
	       (res    '()))
      (cond ;; nb// no else for this approach.
       ((>= runnum nruns) #f)
       ((>= keynum nkeys) 
	(vector-set! header runnum keyvec)
	(set! hdrlst (cons (apply iup:vbox (reverse res)) hdrlst))
	(loop (+ runnum 1) 0 (make-vector nkeys) '()))
       (else
	(let ((labl  (iup:label "" #:size (conc cell-width btn-height)  #:fontsize btn-fontsz #:expand "HORIZONTAL"))) ;; #:expand "HORIZONTAL" "60x15" 
	  (vector-set! keyvec keynum labl)
	  (loop runnum (+ keynum 1) keyvec (cons labl res))))))
    ;; By here the hdrlst contains a list of vboxes containing nkeys labels
    (let loop ((runnum  0)
	       (testnum 0)
	       (testvec  (make-vector ntests))
	       (res    '()))
      (cond
       ((>= runnum nruns) #f) ;;  (vector tableheader runsvec))
       ((>= testnum ntests) 
	(vector-set! runsvec runnum testvec)
	(set! bdylst (cons (apply iup:vbox (reverse res)) bdylst))
	(loop (+ runnum 1) 0 (make-vector ntests) '()))
       (else
	(let* ((button-key (mkstr runnum testnum))
	       (butn       (iup:button
			    (if use-bgcolor #f "   ") ;; button-key 
			    #:size (conc cell-width btn-height )
			    #:expand "HORIZONTAL"
			    #:fontsize btn-fontsz
			    #: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 (dboard:tabdat-buttondat runs-dat) 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-info (rmt:get-test-info-by-id run-id test-id))
					      (test-name (db:test-get-testname test-info))
					      (testpatt  (let ((tlast (rmt:tasks-get-last target runname)))
							   (if tlast
							       (let ((tpatt (tasks:task-get-testpatt tlast)))
								 (if (member tpatt '("0" 0)) ;; known bad historical value - remove in 2017
								     "%"
								     tpatt))
							       "%")))
                                              (item-path (db:test-get-item-path (rmt:get-test-info-by-id run-id test-id)))
                                              (item-test-path (conc test-name "/" (if (equal? item-path "")
									"%" 
									item-path))))
					 (iup:show (dashboard:context-menu run-id test-id target runname test-name testpatt item-test-path test-info) ;; popup-menu
						   #:x 'mouse
						   #:y 'mouse
						   #:modal? "NO")
					 ;; (print "got here")
					 ))
				   (if (eq? pressed 0)
				       (let* ((toolpath (car (argv)))
					      (buttndat (hash-table-ref (dboard:tabdat-buttondat runs-dat) button-key))
					      (test-id  (db:test-get-id (vector-ref buttndat 3)))
					      (run-id   (db:test-get-run_id (vector-ref buttndat 3))))


                                         (dboard:launch-testpanel run-id test-id))))))))
	  (iup:attribute-set! butn "IMAGE" (make-image *images* "BGCOLOR" "222 222 221")) ;;; "BGCOLOR" "BGCOLOR")
	  (hash-table-set! (dboard:tabdat-buttondat runs-dat) 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
			 (iup:split
			  #:orientation "VERTICAL" ;; "HORIZONTAL"
			  #:value 250
			  (dboard:runs-tree-browser commondat runs-dat)
			  (iup:split
			   #:value 200
			   ;; left most block, including row names
			   (apply iup:vbox lftlst)
			   ;; right hand block, including cells
			   (iup:vbox
			    #:expand "YES"
			    ;; the header
			    (apply iup:hbox (reverse hdrlst))
			    (apply iup:hbox (reverse bdylst))
			    (dashboard:runs-horizontal-slider runs-dat))))
			 controls
			 ))
	     (views-cfgdat (common:load-views-config))
	     (additional-tabnames '())
	     (tab-start-num       5)   ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW
	     ;; (data (dboard:tabdat-init (make-d:data)))
	     (additional-views 	;; process views-dat
	      (let ((tab-num tab-start-num)
		    (result  '()))
		(for-each
		 (lambda (view-name)
		   (debug:print 0 *default-log-port* "Adding view " view-name)
		   (let* ((cfgtype (configf:lookup views-cfgdat view-name "type"))) ;; what type of view?
		     (if (not (string? cfgtype))
			 (debug:print-info 0 *default-log-port* "WARNING: view \"" view-name
					   "\" is missing needed sections. "
					   "Please consult the documenation and update ~/.mtviews.config or "
					   *toppath* "/.mtviews.config")
			 (case (string->symbol cfgtype)
			   ;; user supplied source for a tab
			   ;;
			   ((external) ;; was tabs
			    (let ((tab-content (dboard:add-external-tab commondat view-name views-cfgdat #f tab-num)))
			      (set! additional-tabnames (cons (cons tab-num view-name) additional-tabnames))
			      (set! tab-num (+ tab-num 1))
			      (set! result (append result (list tab-content)))))))))
		 (sort (hash-table-keys views-cfgdat)
		       (lambda (a b)
			 (let ((order-a (or (any->number (configf:lookup views-cfgdat a "order")) 999))
			       (order-b (or (any->number (configf:lookup views-cfgdat b "order")) 999)))
			   (> order-a order-b)))))
		result))
	     (tabs (apply iup:tabs
			  #:tabchangepos-cb (lambda (obj curr prev)
					      (debug:catch-and-dump
					       (lambda ()
						 (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
							(tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
						   (dboard:tabdat-layout-update-ok-set! tabdat #f))
						 (dboard:commondat-curr-tab-num-set! commondat curr)
						 (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
							(tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
						   (dboard:commondat-please-update-set! commondat #t)
						   (dboard:tabdat-layout-update-ok-set! tabdat #t)))
					       "tabchangepos"))
			  runs-view
			  (dashboard:summary commondat stats-dat tab-num: 1)
			  ;; (make-runs-view commondat runs2-dat 2)
			  (dashboard:runs-summary commondat onerun-dat tab-num: 2)

			  (dashboard:run-controls commondat runcontrols-dat tab-num: 3)
			  (dashboard:run-times commondat runtimes-dat tab-num: 4)
			  additional-views))
             (target-run (dboard:commondat-target commondat))
             )
	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
	(iup:attribute-set! tabs "TABTITLE0" "Runs")
	(iup:attribute-set! tabs "TABTITLE1" "Summary")
	;; (iup:attribute-set! tabs "TABTITLE2" "Runs2")
	(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")

	;; set the tab names for user added tabs
	(for-each
	 (lambda (tab-info)
	   (iup:attribute-set! tabs (conc "TABTITLE" (car tab-info)) (cdr tab-info)))
	 additional-tabnames)
	
	(iup:attribute-set! tabs "BGCOLOR" "190 190 190")
	;; make the iup tabs object available (for changing color for example)
	(dboard:commondat-hide-not-hide-tabs-set! commondat tabs)
	;; now set up the tabdat lookup
	;; (dboard:common-set-tabdat! commondat 0 stats-dat)
        
        (if target-run
          (begin
            (dboard:tabdat-target-set! runs-dat (string-split target-run "/"))
          )
        )
	(dboard:common-set-tabdat! commondat 0 runs-dat)
	;;(dboard:common-set-tabdat! commondat 2 runs2-dat)
	(dboard:common-set-tabdat! commondat 2 onerun-dat)
	(dboard:common-set-tabdat! commondat 3 runcontrols-dat)
	(dboard:common-set-tabdat! commondat 4 runtimes-dat)

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

(define (dboard:setup-num-rows tabdat)
  (dboard:tabdat-num-tests-set! tabdat (string->number
					(or (args:get-arg "-rows")
					    (get-environment-variable "DASHBOARDROWS")
					    "15"))))
  
(define *tim* (iup:timer))
(define *ord* #f)
(iup:attribute-set! *tim* "TIME" (or (configf:lookup *configdat* "dashboard" "poll-interval") "1000"))
(iup:attribute-set! *tim* "RUN" "YES")

(define *last-recalc-ended-time* 0)







(define (dashboard:recalc modtime please-update-buttons last-db-update-time)
  (or please-update-buttons
      (and ;; (> (current-milliseconds)(+ *last-recalc-ended-time* 150)) ;; can't use this - it needs to be tab specific
	   (> modtime (- last-db-update-time 3)) ;; add three seconds of margin
	   (> (current-seconds)(+ last-db-update-time 1)))))

;; (define *monitor-db-path* #f)
(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 dbdir)
  (handle-exceptions
   exn
   (begin
     (debug:print 2 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: "
		  ((condition-property-accessor 'exn 'message) exn) " db-dir="dbdir ", exn=" exn)
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (common:max (map (lambda (filen)
		      (file-modification-time filen))
		    (cons (conc dbdir "/main.db") (glob (conc dbdir "/?.db")))))))

(define (dashboard:monitor-changed? commondat tabdat)
  (let* ((run-update-time (current-seconds))
	 (monitor-db-path (dboard:tabdat-monitor-db-path tabdat))
	 (monitor-modtime (if (and monitor-db-path (common:file-exists? monitor-db-path))
			      (file-modification-time monitor-db-path)
			      -1)))
    (if (and (eq? (dboard:commondat-curr-tab-num commondat) 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)
	  #t)
	#f)))

(define (dboard:get-last-db-update tabdat context)
  (hash-table-ref/default (dboard:tabdat-last-db-update tabdat) context 0))

(define (dboard:set-last-db-update! tabdat context newtime)
  (hash-table-set! (dboard:tabdat-last-db-update tabdat) context newtime))

;;
(define (dashboard:database-changed? commondat tabdat #!key (context-key 'default))
  (let* ((run-update-time (current-seconds))
         (dbdir           (conc *toppath* "/.mtdb"))
	 (modtime         (dashboard:get-youngest-run-db-mod-time dbdir))
	 (recalc          (dashboard:recalc modtime 
					    (dboard:commondat-please-update commondat) 
					    (dboard:get-last-db-update tabdat context-key))))
    (if recalc 
	(dboard:set-last-db-update! tabdat context-key run-update-time))
    (dboard:commondat-please-update-set! commondat #f)
    recalc))

;; point inside line
;;
(define-inline (dashboard:px-between px lx1 lx2)
  (and (< lx1 px)(> lx2 px)))

;;Not reference anywhere
;;
;; can a bar be placed in row "rownum" covering x1 to x2 without overlapping with existing 
;; bars? Use num-rows to check that a block will fit from rownum to (+ rownum num-rows)
;;
(define (dashboard:row-collision rowhash rownum x1 x2 #!key (num-rows #f))
  (let ((lastrow   (if num-rows (+ rownum num-rows) rownum)))
    (let loop ((i      0)
	       (rowdat (hash-table-ref/default rowhash rownum '())))

    (hash-table-set! rowhash 
		     (+ i rownum)
		     (cons (cons x1 x2) 
			   (hash-table-ref/default rowhash (+ i rownum) '())))
    (if (< i num-rows)
	(loop (+ i 1)))))











;; sort a list of test-ids by the event _time using a hash table of id => testdat
;;
(define-inline (dboard:sort-testsdat-by-event-time test-ids tests-ht)
  (sort test-ids
	(lambda (a b)
	  (< (db:test-get-event_time (hash-table-ref tests-ht a))
	     (db:test-get-event_time (hash-table-ref tests-ht b))))))

	      (lambda (a b)
		(< (db:test-get-event_time (hash-table-ref testsdat (car a)))
		   (db:test-get-event_time (hash-table-ref testsdat (car b))))))))))

;; run times tab data updater
;;
(define (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num)
  (let* ((access-mode      (dboard:tabdat-access-mode tabdat))
         (last-runs-update (dboard:tabdat-last-runs-update tabdat))
         (runs-dat      (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f last-runs-update))
	 (runs-header   (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
	 (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))

	(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))
				   (dboard:tabdat-keys tabdat)))
		  (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 (dboard:tabdat-path-run-ids tabdat) run-path #f))
		 (begin
		   (hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path)
		   ;; 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! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
		   ;; (set! colnum (+ colnum 1))
		   ))))
	 run-ids))
    ;; (print "Updating rundat")
    (if (dboard:tabdat-keys tabdat) ;; have keys yet?
	(let* ((num-keys (length (dboard:tabdat-keys tabdat)))
	       (targpatt (map (lambda (k v)
				(list k v))
			      (dboard:tabdat-keys tabdat)
			      (take (append (or (dboard:tabdat-target tabdat);; (string-split (dboard: "/")
						'("%" "%"))
					    (make-list num-keys "%"))
				    num-keys)
			      ))
	       (runpatt   (if (and (dboard:tabdat-target tabdat)
                                   (list? (dboard:tabdat-target tabdat))
                                   (not (null? (dboard:tabdat-target tabdat))))
                              (last (dboard:tabdat-target tabdat))
                              "%"))
	       (testpatt  (or (dboard:tabdat-test-patts tabdat) "%"))
	       (filtrstr  (conc targpatt "/" runpatt "/" testpatt)))
	  ;; (print "targpatt: " targpatt " runpatt: " runpatt " testpatt: " testpatt)

	  (if (not (equal? (dboard:tabdat-last-filter-str tabdat) filtrstr))
	      (let ((dwg (dboard:tabdat-drawing tabdat)))

		(dboard:tabdat-layout-update-ok-set! tabdat #f)
		(vg:drawing-libs-set! dwg (make-hash-table))
		(vg:drawing-insts-set! dwg (make-hash-table))
		(vg:drawing-cache-set! dwg '())
		(dboard:tabdat-allruns-by-id-set! tabdat (make-hash-table))
		;; (dboard:tabdat-allruns-set! tabdat '())
		(dboard:tabdat-max-row-set! tabdat 0)

	(dwg (dboard:tabdat-drawing tabdat))
	(mtx (dboard:tabdat-runs-mutex tabdat))
	(vch (dboard:tabdat-view-changed tabdat)))
    (if (and cnv dwg vch)
	(begin
	  (vg:drawing-xoff-set! dwg (dboard:tabdat-xadj tabdat))
	  (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)))

(define (dboard:graph-db-open dbstr)
  (let* ((parts (string-split dbstr ":"))
	 (dbpth (if (< (length parts) 2) ;; assume then a filename was provided
		    dbstr
		    (if (equal? (car parts) "sqlite3")
			(cadr parts)
			(begin
			  (debug:print 0 *default-log-port* "ERROR: I only know sqlite3 databases for now: " dbstr)
			  #f)))))
    (if (and dbpth (file-read-access? dbpth))
	(let ((db (sqlite3:open-database dbpth))) ;; (open-database dbpth)))
	  (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 10000))
	  db)
	#f)))

;; sqlite3:path tablename timefieldname varfieldname field1 field2 ...
;;
(define (dboard:graph-read-data cmdstring tstart tend)
  (let* ((parts (string-split cmdstring))) ;; spaces not allowed

					    fieldname
					    (cons
					     (apply vector tstart (cdr zeropt))						    
					     (hash-table-ref/default res-ht fieldname '())))))))
		 fields)
		res-ht)
	      #f)))))

;; graph data 
;;  tsc=timescale, tfn=function; time->x
;;
(define (dboard:graph commondat tabdat tabnum llx lly ulx uly tstart tend tsc tfn compname cmargin)
  (let* ((dwg      (dboard:tabdat-drawing tabdat))
	 (lib      (vg:get/create-lib dwg "runslib"))
	 (cnv      (dboard:tabdat-cnv tabdat))
	 (dur      (- tstart tend)) ;; time duration
	 (cmp      (vg:get-component dwg "runslib" compname))
	 (cfg      (configf:get-section *configdat* "graph"))
	 (stdcolor (vg:rgb->number 120 130 140))
	 (delta-y  (- uly lly))
         (graph-matrix-table (dboard:tabdat-graph-matrix-table tabdat))
         (graph-cell-table (dboard:tabdat-graph-cell-table tabdat))
         (graph-matrix (dboard:tabdat-graph-matrix tabdat))
         (changed      #f))
    (vg:add-obj-to-comp
     cmp 
     (vg:make-rect-obj llx lly ulx uly))
    (vg:add-obj-to-comp
     cmp
     (vg:make-text-obj (- (tfn tstart) 10)(- lly 10)(seconds->year-week/day-time tstart)))
    (let*-values (((span timeunit time-blk first timesym) (common:find-start-mark-and-mark-delta tstart tend)))

			 (loop (+ mark time-blk)(+ count 1))))))
    (for-each 
     (lambda (cf)
       (let* ((alldat  (dboard:graph-read-data (cadr cf) tstart tend)))
	 (if alldat
	     (for-each
	      (lambda (fieldn)
		(let*-values (((dat)                (hash-table-ref alldat fieldn))
                              ((vals minval maxval) (if (null? dat)
                                                        (values '() #f #f)
                                                        (let loop ((hed (car dat))
                                                                   (tal (cdr dat))
                                                                   (res '())
                                                                   (min (vector-ref (car dat) 2))
                                                                   (max (vector-ref (car dat) 2)))
                                                          (let* ((val    (vector-ref hed 2))
                                                                 (newmin (if (< val min) val min))
                                                                 (newmax (if (> val max) val max))
                                                                 (newres (cons val res)))
                                                            (if (null? tal)
                                                                (values (reverse res) (- newmin 2) (+ newmax 2))
                                                                (loop (car tal)(cdr tal) newres newmin newmax)))))))
                  (if (not (hash-table-exists? graph-matrix-table fieldn))
                      (begin
                        (let* ((graph-color-rgb (vg:generate-color-rgb))
                               (graph-color (vg:iup-color->number graph-color-rgb))
                               (graph-matrix-col (dboard:tabdat-graph-matrix-col tabdat))
                               (graph-matrix-row (dboard:tabdat-graph-matrix-row tabdat))
                               (graph-cell       (conc graph-matrix-row ":" graph-matrix-col)) 
                               (graph-dat (make-dboard:graph-dat
                                                  id: fieldn
                                                  color: graph-color
                                                  flag: #t
                                                  cell: graph-cell
                                                  )))
                          (hash-table-set! graph-matrix-table fieldn graph-dat)
                          (hash-table-set! graph-cell-table graph-cell graph-dat)
                          ;; (print "Graph data " graph-matrix-row " " graph-matrix-col " " fieldn " " graph-color " " graph-color-rgb " ")
                          ;; (print "Graph data " graph-matrix-row " " graph-matrix-col " " fieldn " " graph-color " " graph-color-rgb " ")
                          (set! changed #t)
                          (iup:attribute-set! graph-matrix (conc graph-matrix-row ":"  graph-matrix-col) fieldn)
                          (iup:attribute-set! graph-matrix (conc "BGCOLOR" (conc graph-matrix-row ":"  graph-matrix-col)) graph-color-rgb)
                          (if (> graph-matrix-col 10)
                              (begin
                                (dboard:tabdat-graph-matrix-col-set! tabdat 1)
                                (dboard:tabdat-graph-matrix-row-set! tabdat (+ graph-matrix-row 1)))
                              (dboard:tabdat-graph-matrix-col-set! tabdat (+ graph-matrix-col 1)))
                          )))
		  (if (not (null? vals)) 
		      (let* (;; (maxval   (apply max vals))
			     ;; (minval   (min 0 (apply min vals)))
			     (yoff        (- minval lly)) ;;  minval))
			     (deltaval    (- maxval minval))
			     (yscale      (/ delta-y (if (zero? deltaval) 1 deltaval)))
			     (yfunc       (lambda (y)(+ lly (* yscale (- y minval))))) ;; (lambda (y)(* (+ y yoff) yscale))))
                             (graph-dat   (hash-table-ref graph-matrix-table fieldn))
                             (graph-color (dboard:graph-dat-color graph-dat))

                             (graph-flag (dboard:graph-dat-flag graph-dat)))
                        (if graph-flag
                            (begin
                              (vg:add-obj-to-comp
                               cmp 
                               (vg:make-text-obj (- llx 10)(yfunc maxval) (conc maxval)))
                              (vg:add-obj-to-comp
                               cmp 
                               (vg:make-text-obj (- llx 10)(yfunc minval) (conc minval)))
                              (fold 
                               (lambda (next prev)  ;; #(time ? val) #(time ? val)
                                 (if prev
                                     (let* ((yval        (vector-ref prev 2))
                                            (yval-next   (vector-ref next 2))
                                            (last-tval   (tfn   (vector-ref prev 0)))
                                            (last-yval   (yfunc yval)) ;; (+ lly (* yscale (vector-ref prev 2))))
                                            (next-yval   (yfunc yval-next))
                                            (curr-tval   (tfn   (vector-ref next 0))))
                                       (if (>= curr-tval last-tval)
                                           (begin
                                             (vg:add-obj-to-comp
                                              cmp 
                                              ;;(vg:make-rect-obj last-tval lly curr-tval last-yval ;; (- stval 2) lly (+ stval 2)(+ lly (* yval yscale))
                                              (vg:make-line-obj last-tval last-yval curr-tval last-yval
                                                                line-color: graph-color))
                                             (vg:add-obj-to-comp
                                              cmp 
                                              ;;(vg:make-rect-obj last-tval lly curr-tval last-yval ;; (- stval 2) lly (+ stval 2)(+ lly (* yval yscale))
                                              (vg:make-line-obj curr-tval last-yval curr-tval next-yval
                                                                line-color: graph-color)))         
                                           (debug:print 0 *default-log-port* "ERROR: curr-tval is not > last-tval; curr-tval " curr-tval ", last-tval " last-tval))))
                                 next)

                               #f ;; (vector tstart minval minval)
                               dat)












                              )))))) ;; for each data point in the series
	      (hash-table-keys alldat)))))
     cfg)
    (if changed (iup:attribute-set! graph-matrix "REDRAW" "ALL"))))
	 
;; 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

	       (num-runs     (length allruns))
	       (cnv          (dboard:tabdat-cnv tabdat))
	       (compact-layout (dboard:tabdat-compact-layout tabdat))
	       (row-height     (if compact-layout 2 10))
	       (graph-height 120)
	       (run-to-run-margin 25))
	  (dboard:tabdat-layout-update-ok-set! tabdat #t)
	  (if (and (canvas? cnv)
                   (not (null? allruns))) ;; allruns can go null when browsing the runs tree
	      (let*-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
			    ((originx originy)             (canvas-origin cnv))
			    ((calc-y)                      (lambda (rownum)
							     (- (/ sizey 2)
								(* rownum row-height))))
			    ((fixed-originx)               (if (dboard:tabdat-originx tabdat)
							       (dboard:tabdat-originx tabdat)

					      (dboard:rundat-hierdat rundat)))
			       (tests-ht  (dboard:rundat-tests rundat))
			       (all-tids  (hash-table-keys   tests-ht)) ;; (apply append hierdat)) ;; was testsdat
			       (testsdat  (hash-table-values tests-ht))
			       (runcomp   (vg:comp-new));; new component for this run
			       (rows-used (make-hash-table)) ;; keep track of what parts of the rows are used here row1 = (obj1 obj2 ...)
			       ;; (row-height 4)
			       (run-start  (common:min-max < (map db:test-get-event_time testsdat)))
			       (run-end    (let ((re (common:min-max > (map (lambda (t)(+ (db:test-get-event_time t)(db:test-get-run_duration t))) testsdat))))
					     (max re (+ 1 run-start)))) ;; use run-start+1 if run-start == run-end so delta is not zero
			       (timeoffset (- run-start)) ;; (+ fixed-originx canvas-margin) run-start))
			       (run-duration (- run-end run-start))
			       (timescale  (/ (- sizex (* 2 canvas-margin))
					      (if (> run-duration 0)
						  run-duration
						  (current-seconds)))) ;; a least lously guess
			       (maptime    (lambda (tsecs)(* timescale (+ tsecs timeoffset))))
			       (num-tests  (length hierdat))
			       (tot-tests  (length testsdat))
			       (width      (* timescale run-duration))
			       (graph-lly  (calc-y (/ -50 row-height)))
			       (graph-uly  (- (calc-y 0) canvas-margin))
			       (sec-per-50pt (/ 50 timescale))
			       )
			  ;; (print "timeoffset: " timeoffset " timescale: " timescale " run-duration: " (seconds->hr-min-sec run-duration) " width: " width " sec-per-50pt: " sec-per-50pt)
			  ;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx)
			  ;; (mutex-lock! mtx)
			  (vg:add-comp-to-lib runslib run-full-name runcomp)
			  ;; Have to keep moving the instantiated box as it is anchored at the lower left
			  ;; this should have worked for x in next statement? (maptime run-start)
			  ;; add 60 to make room for the graph
			  (vg:instantiate drawing "runslib" run-full-name run-full-name 8 (- (calc-y curr-run-start-row) (+ 5 graph-height run-to-run-margin)))
			  ;; (mutex-unlock! mtx)
			  ;; (set! run-start-row (+ max-row 2))
			  ;; (dboard:tabdat-start-row-set! tabdat (+ new-run-start-row 1))
			  ;; get tests in list sorted by event time ascending
			  (let testsloop ((test-ids  (car hierdat))              ;; loop on tests (NOTE: not items!)
					  (tests-tal (cdr hierdat))
					  (test-num  1))
			    (let ((iterated     (> (length test-ids) 1))

						;; (vg:instance-move drawing run-full-name 0 (calc-y (dboard:tabdat-max-row tabdat)))
						(dboard:tabdat-view-changed-set! tabdat #t)
						(cons obj test-objs))))))
				  ;; (print "event_time: " (db:test-get-event_time   testdat) " mapped event_time: " event-time)
				  ;; (print "run-duration: "  (db:test-get-run_duration testdat) " mapped run_duration: " run-duration)
				  (if (> item-num 50)
				      (if (eq? 0 (modulo item-num 50))
					  (debug:print 0 *default-log-port* "processing " run-num " of " num-runs " runs " item-num " of " num-items " of test " test-name ", " test-num " of " num-tests " tests")))
				  ;; (print "test-name: " test-name " event-time: " event-time " run-duration: " run-duration)
				  (let ((newdoneruns (cons rundat doneruns)))
				    (if (null? tidstal)
					(if iterated
					    (let* ((xtents (vg:get-extents-for-objs drawing new-test-objs))
						   (llx (- (car xtents)  10))
						   (lly (- (cadr xtents) 10))

					(if (dboard:tabdat-layout-update-ok tabdat)
					    (testitemloop (car tidstal)(cdr tidstal)(+ item-num 1) new-test-objs)
					    (escapeloop #t) ;; (dboard:tabdat-layout-update-ok tabdat)
					    )))))
			      ;; If it is an iterated test put box around it now.
			      (if (not (null? tests-tal))
				  (if #f ;; (> (- (current-seconds) update-start-time) 5)
				      (debug:print 0 *default-log-port* "drawing runs taking too long")
				      (if (dboard:tabdat-layout-update-ok tabdat)
					  (testsloop  (car tests-tal)(cdr tests-tal)(+ test-num 1))
					  (escapeloop #t) ;; (dboard:tabdat-layout-update-ok tabdat)
					  )))))
			  ;; 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))
				 (new-xtnts (apply vg:grow-rect 5 5 extents))
				 (llx       (list-ref new-xtnts 0))
				 (lly       (list-ref new-xtnts 1))
				 (ulx       (list-ref new-xtnts 2))
				 (uly       (list-ref new-xtnts 3))
				 (outln     (vg:make-rect-obj -5 lly ulx uly 
							      text: run-full-name
							      line-color:  (vg:rgb->number  255 0 255 a: 128))))
					;  (vg:components-get-extents d1 c1)))
			    ;; this is the box around the run
			    ;; (mutex-lock! mtx)
			    (vg:add-obj-to-comp runcomp outln)
			    ;; (mutex-unlock! mtx)
			    ;; this is where we have enough info to place the graph
			    (dboard:graph commondat tabdat tab-num -5 (+ uly 10) ulx (+ uly graph-height 3) run-start run-end timescale maptime run-full-name canvas-margin)
			    (dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat)(quotient (+ graph-height 40 3) row-height)))
			    ;; (vg:instance-move drawing run-full-name 0 (dboard:tabdat-max-row tabdat))
			    ))
			;; end of the run handling loop 
			(if (not (dboard:tabdat-layout-update-ok tabdat))
			    (escapeloop #t) ;; (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
					(debug:print 0 *default-log-port* "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 (dboard:tabdat-layout-update-ok tabdat)
					    (runloop (car runtal)(cdr runtal) (+ run-num 1) newdoneruns)
					    (escapeloop #t) ;; (dboard:tabdat-layout-update-ok tabdat)
					    ))))))))) ;;  new-run-start-row
		)))
	(debug:print 2 *default-log-port* "no tabdat for run-times-tab-updater"))))

;; handy trick for printing a record
;;
;;   (pp (dboard:tabdat->alist tabdat))
;; 
;;  removing the tabdat-values proc 
;;
;; (define (tabdat-values tabdat)

;; runs update-rundat using the various filters from the gui
;;
(define (dashboard:do-update-rundat tabdat)
  (dboard: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" "%/%")

   ;; generate key patterns from the target stored in tabdat
   (let* ((dbkeys (dboard:tabdat-dbkeys tabdat)))

     (let ((fres   (if (dboard:tabdat-target tabdat)
                       (let ((ptparts (append (dboard:tabdat-target tabdat)(make-list (length dbkeys) "%"))))
                         (map (lambda (k v)(list k v)) dbkeys ptparts))
                       (let ((res '()))

                         (for-each (lambda (key)
                                     (if (not (equal? key "runname"))
                                         (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f)))
                                           (if val (set! res (cons (list key val) res))))))
                                   dbkeys)
                         res))))

       fres))))

(define (dashboard:runs-tab-updater commondat tab-num)
  (debug:catch-and-dump 
   (lambda ()
     (let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
	    (dbkeys (dboard:tabdat-dbkeys tabdat)))
       (dashboard:do-update-rundat tabdat)
       (let ((uidat (dboard:commondat-uidat commondat)))
	 (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
       ))
   "dashboard:runs-tab-updater"))









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




(stop-the-train)

(define (main)
  ;; (print "Starting dashboard main")
    
  (let* ((mtdb-path (conc *toppath* "/.mtdb/main.db"))
         (target (args:get-arg "-target"))
         (commondat       (dboard:commondat-make)))
    (if target
        (begin
          (hash-table-delete! args:arg-hash "-target")  ;; workaround for the following commented out function
          ;; (args:remove-arg-from-ht "-target")   This function is in mtargs/mtargs.scm, but it's in an egg that is not in the current build of chicken 4.10
          (dboard:commondat-target-set! commondat target)
        )
    )

    (if (not (launch:setup))
        (begin
          (debug:print 0 *default-log-port* "Failed to find megatest.config, exiting") 
          (exit 1)
        )
    )

    #;(if (not (common:on-homehost?))
    (begin
      (debug:print 0 *default-log-port* "WARNING: You are starting the dashboard on a machine that is not the homehost:" (server:get-homehost))
      (debug:print 0 *default-log-port* "It will be slower.")
      ))


    (if (and (common:file-exists? mtdb-path)
	     (file-write-access? mtdb-path))
	(if (not (args:get-arg "-skip-version-check"))
            (common:exit-on-version-changed)))

    (let* ()
      ;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
      (cond 
       ((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))
	      (dashboard-tests: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)))))
       (else
	(dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat))
	(dboard:commondat-curr-tab-num-set! commondat 0)
	(dboard:commondat-add-updater 
	 commondat 
	 (lambda ()
	   (dashboard:runs-tab-updater commondat 0))
	 tab-num: 0)
        ;; may not want this alive (manually merged it from v1.66)
	;; (dboard:commondat-add-updater 
	;;  commondat 
	;;  (lambda ()
	   ;;  (dashboard:runs-tab-updater commondat 1))
	;; tab-num: 2)
	(iup:callback-set! *tim*
			   "ACTION_CB"
			   (lambda (time-obj)
			     (let ((update-is-running #f))
			       ;; (mutex-lock! (dboard:commondat-update-mutex commondat))
			       (set! update-is-running (dboard:commondat-updating commondat))
			       (if (not update-is-running)
				   (dboard:commondat-updating-set! commondat #t))
			       ;; (mutex-unlock! (dboard:commondat-update-mutex commondat))
			       (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
			     (begin
			     (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat)
			     ;; (mutex-lock! (dboard:commondat-update-mutex commondat))
			     (dboard:commondat-updating-set! commondat #f)
			     ;; (mutex-unlock! (dboard:commondat-update-mutex commondat))
			     )))
			     1))))




      ;; (debug:print 0 *default-log-port* "Starting updaters")







      (let ((th1 (make-thread (lambda ()
				(thread-sleep! 1)
				(dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
				) "update buttons once"))
	    (th2 (make-thread iup:main-loop "Main loop")))
        ;; (print "Starting main loop")
	(thread-start! th2)
	(thread-join! th2)
      )
    )
  )
)


(define last-copy-time 0)


;; Sync to tmp only if in read-only mode.



(define (sync-db-to-tmp tabdat)
  (let* ((db-file "./.mtdb/main.db"))
    (if (and (not (file-write-access? db-file)) ( > (current-seconds) (+ last-copy-time 5)))
      (begin
        (db:multi-db-sync (db:setup) 'old2new)
        (set! last-copy-time (current-seconds))
      )
    )
  )
)


;; ########################### top level code ########################
;; check for MT_* environment variables and exit if found
(if (not (args:get-arg "-test"))
    (begin
      (for-each (lambda (var)
		  ;; (display " ")(display var)
		  (if (get-environment-variable var)
		      (begin

			(debug:print 0 *default-log-port* "ERROR: environment variable " var " is set in this terminal, this will cause you problems. Exiting now.")
			(exit 1))))
		'("MT_RUN_AREA_HOME" "MT_MEGATEST" "MT_CMDINFO" "MT_TEST_RUN_DIR" "MT_LINKTREE" "MT_TESTSUITENAME"))
    )
)

;; This is NOT good
;; (setenv "MT_RUN_AREA_HOME" (get-environment-variable "PWD"))
;; This should be OK but it really should not be necessary
(setenv "MT_RUN_AREA_HOME" (current-directory))

(if (not (null? remargs))
  (if remargs
    (begin
      (debug:print 0 *default-log-port* "Unrecognised arguments: " (string-intersperse remargs " "))
      (exit)
    )
    (begin
      (print help)
      (exit)
    )
  )
)

(if (args:get-arg "-h")
    (begin
      (print help)
      (exit)))




(if (args:get-arg "-start-dir")
    (if (directory-exists? (args:get-arg "-start-dir"))
        (let ((fullpath (common:real-path (args:get-arg "-start-dir"))))
          (setenv "PWD" fullpath)
          (change-directory fullpath))
	(begin
	  (debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.")
 	  (exit 1))))


;; deal with RH 5.11 gtk lib or iup lib missing detachbox feature
;; first check for the switch
;;
(if (or 
	(configf:lookup *configdat* "dashboard" "no-detachbox")
        (not (file-exists? "/etc/os-release")))
    (set! iup:detachbox iup:vbox))



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


(if (args:get-arg "-repl")
    (repl)
    (main))