Megatest

				    (loop (car tal)(cdr tal)))))))
		      ;; no match, try again
		      (if (null? tal)
			  fallback-launcher
			  (loop (car tal)(cdr tal))))))))
	fallback-launcher)))
  
;;======================================================================
;; D A S H B O A R D   U S E R   V I E W S
;;======================================================================

;; first read ~/views.config if it exists, then read $MTRAH/views.config if it exists
;;
(define (common:load-views-config)
  (let* ((view-cfgdat    (make-hash-table))
	 (home-cfgfile   (conc (get-environment-variable "HOME") "/.mtviews.config"))
	 (mthome-cfgfile (conc *toppath* "/.mtviews.config")))
    (if (file-exists? mthome-cfgfile)
	(read-config mthome-cfgfile view-cfgdat #t))
    ;; we load the home dir file AFTER the MTRAH file so the user can clobber settings when running the dashboard in read-only areas
    (if (file-exists? home-cfgfile)
	(read-config home-cfgfile view-cfgdat #t))
    view-cfgdat))

    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

;; data common to all tabs goes here
;;
(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

  ;; 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") "10")))                 : 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)  ;;     

;; 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* ((num-to-get  100)
	 (states      (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)))
	 (statuses    (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)))
	 (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

;; 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* ((keys             (rmt:get-keys))
	 (last-runs-update (dboard:tabdat-last-runs-update tabdat))
         (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)))
    (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 '())

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

(define (mark-for-update tabdat)
  ;; (dboard:tabdat-filters-changed-set! tabdat #t)
  (dboard:tabdat-last-db-update-set! tabdat 0))

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

;; target populating logic

						 (now-time         (current-seconds)))
					     (dashboard:run-times-tab-canvas-updater commondat tabdat tab-num)
					     (if (> (- now-time last-data-update) 5)
						 (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 now-time)
						       ;; this is threadified to return control to the gui for a redraw.
						       ;; it relies on the running-layout flag to prevent overlapping 
						       ;; calls.
						       (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")))
						     ))))))

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

				       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:one-run-updater commondat tabdat tb cell-lookup run-matrix)
  (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
	 (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))
				   (vector-ref runs-dat 1))
			 ht)))
    (dboard:update-tree tabdat runs-hash runs-header tb)
    (if run-id
        (let* (
               
               (last-update  (hash-table-ref/default (dboard:tabdat-run-update-times tabdat) run-id 0))
               (db-path      (or (hash-table-ref/default (dboard:tabdat-run-db-paths tabdat) run-id #f)
                                 (let* ((db-dir (tasks:get-task-db-path))
                                        (db-pth (conc db-dir "/" run-id ".db")))
                                   (hash-table-set! (dboard:tabdat-run-db-paths tabdat) run-id db-pth)
                                   db-pth)))
               (tests-dat    (if (or (not run-id)
                                     (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")
                                     (not (hash-table-exists? (dboard:tabdat-last-test-dat tabdat) run-id))
                                     (>= (file-modification-time db-path) last-update))
                                 (dboard:get-tests-dat tabdat run-id last-update)
                                 (hash-table-ref (dboard:tabdat-last-test-dat tabdat) run-id)))
               (tests-mindat (dcommon:minimize-test-data tests-dat))
               (indices      (common:sparse-list-generate-index tests-mindat)) ;;  proc: set-cell))
               (row-indices  (cadr indices))
               (col-indices  (car indices))
               (max-row      (if (null? row-indices) 1 (common:max (map cadr row-indices))))
               (max-col      (if (null? col-indices) 1 (common:max (map cadr col-indices))))
               (max-visible  (max (- (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-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))
          (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))))))
                      tests-mindat)
            
            ;; 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* "one-run-updater, changed: " changed " pass-num: " pass-num)
            ;; (print "one-run-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))

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

;;======================================================================
;;  H A N D L E   U S E R   C O N T R I B U T E D   V I E W S
;;======================================================================

(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 (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))
	   (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))
	   (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))
	 (print "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))
					   (debug:print 0 *default-log-port* "ERROR: failed call procedure \"" updater
							"\", with; tabnum=" tabnum ", 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))

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

		      #:click-cb
		      (lambda (obj lin col status)
			(let* ((toolpath (car (argv)))
			       (key      (conc lin ":" col))
			       (test-id  (hash-table-ref/default cell-lookup key -1))
			       (cmd      (conc toolpath " -test " (dboard:tabdat-curr-run-id tabdat) "," test-id "&")))
			  (system cmd)))))
	 (one-run-updater  ;; RA => Prework done to ensure runs set before calling one-run-updater
          (lambda ()
	    (mutex-lock! update-mutex)


            (if  (or (dashboard:database-changed? commondat tabdat)
                     (dboard:tabdat-view-changed tabdat))
                 (debug:catch-and-dump
                  (lambda () ;; check that run-matrix is initialized before calling the updater
		    (if run-matrix 
			(dashboard:one-run-updater commondat tabdat tb cell-lookup run-matrix)))
                  "dashboard:one-run-updater")

					       (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)))
					;(iup:button "inc rows" #:action (lambda (obj)(dboard:tabdat-num-tests-set! tabdat (+ (dboard:tabdat-num-tests tabdat) 1))))
					;(iup:button "dec rows" #:action (lambda (obj)(dboard:tabdat-num-tests-set! tabdat (if (> (dboard:tabdat-num-tests tabdat) 0)(- (dboard:tabdat-num-tests tabdat) 1) 0))))
     )))

(define (dashboard:popup-menu buttndat run-id test-id target runname test-name testpatt)
  (iup:menu 
   (iup:menu-item
    "Run"
    (iup:menu              
     (iup:menu-item
      (conc "Rerun " testpatt)
      #:action
      (lambda (obj)
        ;; (print "buttndat: " buttndat " run-id: " run-id " test-id: " test-id " target: " target " runname: " runname " test-name: " test-name " testpatt: " testpatt)
	(common:run-a-command
	 (conc "megatest -run -target " target
	       " -runname " runname
	       " -testpatt " testpatt
	       " -preclean -clean-cache")
	 )))
     (iup:menu-item

			   ;; right hand block, including cells
			   (iup:vbox
			    ;; the header
			    (apply iup:hbox (reverse hdrlst))
			    (apply iup:hbox (reverse bdylst)))))
			 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)
			    (let ((tab-content (dboard:add-external-tab commondat view-name views-cfgdat #f tab-num))) ;; was tabs
			      (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"))
			  (dashboard:summary commondat stats-dat tab-num: 0)
			  runs-view
			  (dashboard:one-run commondat onerun-dat tab-num: 2)
			  ;; (dashboard:new-view db data new-view-dat tab-num: 3)
			  (dashboard:run-controls commondat runcontrols-dat tab-num: 3)
			  (dashboard:run-times commondat runtimes-dat tab-num: 4)
			  additional-views)))
	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
	(iup:attribute-set! tabs "TABTITLE0" "Summary")
	(iup:attribute-set! tabs "TABTITLE1" "Runs")
	(iup:attribute-set! tabs "TABTITLE2" "Run Summary")
	(iup:attribute-set! tabs "TABTITLE3" "Run Control")
	(iup:attribute-set! tabs "TABTITLE4" "Run Times")
	;; (iup:attribute-set! tabs "TABTITLE3" "New View")
	;; (iup:attribute-set! tabs "TABTITLE4" "Run Control")

	;; 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)
	(dboard:common-set-tabdat! commondat 1 runs-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)

	      (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* ((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))
	 (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)))))
	 (tb            (dboard:tabdat-runs-tree tabdat))
	 (num-runs      (length (hash-table-keys runs-hash)))
	 (update-start-time (current-seconds))
	 (inc-mode      #f))
    (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
    ;; fill in the tree
    (if (and tb 
	     (not inc-mode))
	(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-allruns-by-id-set! tabdat (make-hash-table))
		;; (dboard:tabdat-allruns-set! tabdat '())
		(dboard:tabdat-max-row-set! tabdat 0)
		(dboard:tabdat-last-filter-str-set! tabdat filtrstr)))
	  (update-rundat tabdat
			 runpatt
			 ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") 
			 (dboard:tabdat-numruns tabdat)
			 testpatt ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
			 ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")
			 
			 targpatt
			 
			 ;; old method 
			 ;; (let ((res '()))

(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)))
       ;;(print "RA => calling runs-tab-updater with commondat " commondat " tab-num " tab-num)
       ;;(tabdat-values tabdat) ;;RA added 
       (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" "%/%")
		      ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%")
		      (let* ((dbkeys (dboard:tabdat-dbkeys tabdat)))
			;; (print "dbkeys: " dbkeys)

    (let ((th1 (make-thread (lambda ()
			      (thread-sleep! 1)
			      (dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
			      ;; (dboard:commondat-please-update-set! commondat #t) ;; MRW: ww36.3 - why was please update set true here? Removing it for now.
			      ;; (dashboard:run-update commondat)
			      ) "update buttons once"))
	  (th2 (make-thread iup:main-loop "Main loop")))
      ;; (thread-start! th1)
      (thread-start! th2)
      (thread-join! th2))))

(main)

;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;;  to extract info from the structure returned
;;
(define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit fields last-update) ;; test-name)
  (let* ((tmp      (runs:get-std-run-fields keys (or fields '("id" "runname" "state" "status" "owner" "event_time"))))
	 (keystr   (car tmp))
	 (header   (cadr tmp))
	 (res     '())
	 (key-patt "")
	 (runwildtype (if (substring-index "%" runnamepatt) "like" "glob"))
	 (qry-str  #f)
	 (keyvals  (if targpatt (keys:target->keyval keys targpatt) '())))
    (for-each (lambda (keyval)
		(let* ((key    (car keyval))
		       (patt   (cadr keyval))
		       (fulkey (conc ":" key))
		       (wildtype (if (substring-index "%" patt) "like" "glob")))
		  (if patt
		      (set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'"))
		      (begin
			(debug:print-error 0 *default-log-port* "searching for runs with no pattern set for " fulkey)
			(exit 6)))))
	      keyvals)
    (set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt 
			(if last-update
			       (conc " AND last_update >= " last-update " ")
			       " ")
			" ORDER BY event_time "
			(if limit  (conc " LIMIT " limit)   "")
			(if offset (conc " OFFSET " offset) "")
			";"))
    (debug:print-info 4 *default-log-port* "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
    (db:with-db dbstruct #f #f ;; reads db, does not write to it.
		(lambda (db)
		  (sqlite3:for-each-row

					       (iup:attribute-set! tb "VALUE" val)
					       (dboard:tabdat-run-name-set! tabdat val)
					       (dashboard:update-run-command tabdat))))
				       "command-runname-selector lb action"))))
	  (refresh-runs-list (lambda ()
			       (if (dashboard:database-changed? commondat tabdat)
				   (let* ((target        (dboard:tabdat-target-string tabdat))
					  (runs-for-targ (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" target #f #f #f 0))
					  (runs-header   (vector-ref runs-for-targ 0))
					  (runs-dat      (vector-ref runs-for-targ 1))
					  (run-names     (cons default-run-name 
							       (map (lambda (x)
								      (db:get-value-by-header x runs-header "runname"))
								    runs-dat))))
				     ;; (iup:attribute-set! lb "REMOVEITEM" "ALL")

;; Always use two or four digit decimal
;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.6105)

	       (testpatt    (common:args-get-testpatt #f))
	       ;; (if (args:get-arg "-testpatt") 
	       ;;  	        (args:get-arg "-testpatt") 
	       ;;  	        "%"))
	       (keys        (rmt:get-keys)) ;; (db:get-keys dbstruct))
	       ;; (runsda   t  (db:get-runs dbstruct runpatt #f #f '()))
	       (runsdat     (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) ;; (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
			           	 #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0))
	       (runstmp     (db:get-rows runsdat))
	       (header      (db:get-header runsdat))
	       ;; this is "-since" support. This looks at last mod times of <run-id>.db files
	       ;; and collects those modified since the -since time.
	       (runs        (if (and (not (null? runstmp))
				     (args:get-arg "-since"))
				(let ((changed-ids (db:get-changed-run-ids (string->number (args:get-arg "-since")))))

	      (set! *client-non-blocking-mode* #t)
	      (import extras) ;; might not be needed
	      ;; (import csi)
	      (import readline)
	      (import apropos)
	      ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
	      (include "readline-fix.scm")

	      (if *use-new-readline*
		  (begin
		    (install-history-file (get-environment-variable "HOME") ".megatest_history") ;;  [homedir] [filename] [nlines])
		    (current-input-port (make-readline-port "megatest> ")))
		  (begin
		    (gnu-history-install-file-manager
		     (string-append

;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db-get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;;  to extract info from the structure returned
;;
(define (mt:get-runs-by-patt keys runnamepatt targpatt)
  (let loop ((runsdat  (rmt:get-runs-by-patt keys runnamepatt targpatt 0 500 #f 0))
	     (res      '())
	     (offset   0)
	     (limit    500))
    ;; (print "runsdat: " runsdat)
    (let* ((header    (vector-ref runsdat 0))
	   (runslst   (vector-ref runsdat 1))
	   (full-list (append res runslst))
	   (have-more (eq? (length runslst) limit)))
      ;; (debug:print 0 *default-log-port* "header: " header " runslst: " runslst " have-more: " have-more)
      (if have-more 
	  (let ((new-offset (+ offset limit))
		(next-batch (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit #f 0)))
	    (debug:print-info 4 *default-log-port* "More than " limit " runs, have " (length full-list) " runs so far.")
	    (debug:print-info 0 *default-log-port* "next-batch: " next-batch)
	    (loop next-batch
		  full-list
		  new-offset
		  limit))
	 (vector header full-list)))))

(define (rmt:set-run-status run-id run-status #!key (msg #f))
  (rmt:send-receive 'set-run-status #f (list run-id run-status msg)))

(define (rmt:update-run-event_time run-id)
  (rmt:send-receive 'update-run-event_time #f (list run-id)))

(define (rmt:get-runs-by-patt  keys runnamepatt targpatt offset limit fields last-runs-update) ;; fields of #f uses default
  (rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit fields last-runs-update)))

(define (rmt:find-and-mark-incomplete run-id ovr-deadtime)
  (if (rmt:send-receive 'have-incompletes? run-id (list run-id ovr-deadtime))
      (rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))))

(define (rmt:get-main-run-stats run-id)
  (rmt:send-receive 'get-main-run-stats #f (list run-id)))