Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -1,11 +1,11 @@
 FILES=$(glob *.scm)
 
 megatest: common.scm configf.scm db.scm keys.scm launch.scm megatest.scm process.scm runs.scm gui.scm
 	csc megatest.scm 
 
-dashboard: megatest dashboard.scm 
+dashboard: megatest dashboard.scm dashboard-tests.scm
 	csc dashboard.scm
 
 $(PREFIX)/bin/megatest : megatest
 	@echo Installing to PREFIX=$(PREFIX), use ^C to cancel and change
 	sleep 5

Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -21,16 +21,19 @@
 (define getenv get-environment-variable)
 
 (define home (getenv "HOME"))
 (define user (getenv "USER"))
 
+;; global gletches
 (define *configinfo* #f)
 (define *configdat*  #f)
 (define *toppath*    #f)
 (define *already-seen-runconfig-info* #f)
 (define *waiting-queue* (make-hash-table))
 (define *globalexitstatus* 0) ;; attempt to work around possible thread issues
+(define *passnum*     0) ;; when running track calls to run-tests or similar
+
 
 (define-inline (get-with-default val default)
   (let ((val (args:get-arg val)))
     (if val val default)))
 

ADDED   dashboard-tests.scm
Index: dashboard-tests.scm
==================================================================
--- /dev/null
+++ dashboard-tests.scm
@@ -0,0 +1,369 @@
+;;======================================================================
+;; Copyright 2006-2011, Matthew Welland.
+;; 
+;;  This program is made available under the GNU GPL version 2.0 or
+;;  greater. See the accompanying file COPYING for details.
+;; 
+;;  This program is distributed WITHOUT ANY WARRANTY; without even the
+;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;;  PURPOSE.
+;;======================================================================
+
+;;======================================================================
+;; Test info panel
+;;======================================================================
+(define (test-info-panel testdat store-label widgets)
+  (iup:frame 
+   #:title "Test Info" ; #:expand "YES"
+   (iup:hbox ; #:expand "YES"
+    (apply iup:vbox ; #:expand "YES"
+	   (append (map (lambda (val)
+			  (iup:label val ; #:expand "HORIZONTAL"
+				     ))
+			(list "Testname: "
+			      "Item path: "
+			      "Current state: "
+			      "Current status: "
+			      "Test comment: "
+			      "Test id: "))
+		   (list (iup:label "" #:expand "VERTICAL"))))
+    (apply iup:vbox  ; #:expand "YES"
+	   (list 
+	    (store-label "testname"
+			 (iup:label (db:test-get-testname  testdat) #:expand "HORIZONTAL")
+			 (lambda (testdat)(db:test-get-testname testdat)))
+	    (store-label "item-path"
+			 (iup:label (db:test-get-item-path testdat) #:expand "HORIZONTAL")
+			 (lambda (testdat)(db:test-get-item-path testdat)))
+	    (store-label "teststate" 
+			 (iup:label (db:test-get-state testdat) #:expand "HORIZONTAL")
+			 (lambda (testdat)
+			   (db:test-get-state testdat)))
+	    (let ((lbl   (iup:label (db:test-get-status testdat) #:expand "HORIZONTAL")))
+	      (hash-table-set! widgets "teststatus"
+			       (lambda (testdat)
+				 (let ((newstatus (db:test-get-status testdat))
+				       (oldstatus (iup:attribute lbl "TITLE")))
+				   (if (not (equal? oldstatus newstatus))
+				       (begin
+					 (iup:attribute-set! lbl "FGCOLOR" (get-color-for-state-status (db:test-get-state testdat)
+												       (db:test-get-status testdat)))
+					 (iup:attribute-set! lbl "TITLE" (db:test-get-status testdat)))))))
+	      lbl)
+	    (store-label "testcomment"
+			 (iup:label "TestComment                             "
+				    #:expand "HORIZONTAL")
+			 (lambda (testdat)
+			   (db:test-get-comment testdat)))
+	    (store-label "testid"
+			 (iup:label "TestId                             "
+				    #:expand "HORIZONTAL")
+			 (lambda (testdat)
+			   (db:test-get-id testdat))))))))
+
+;;======================================================================
+;; Run info panel
+;;======================================================================
+(define (run-info-panel keydat testdat runname)
+  (iup:frame 
+   #:title "Megatest Run Info" ; #:expand "YES"
+   (iup:hbox ; #:expand "YES"
+    (apply iup:vbox ; #:expand "YES"
+	   (append (map (lambda (keyval)
+			  (iup:label (conc (car keyval) " ") ; #:expand "HORIZONTAL"
+				     ))
+			keydat)
+		   (list (iup:label "runname "))))
+    (apply iup:vbox
+	   (append (map (lambda (keyval)
+			  (iup:label (cadr keyval) #:expand "HORIZONTAL"))
+			keydat)
+		   (list (iup:label runname)(iup:label "" #:expand "VERTICAL")))))))
+  
+;;======================================================================
+;; Host info panel
+;;======================================================================
+(define (host-info-panel testdat store-label)
+  (iup:frame
+   #:title "Remote host and Test Run Info" ; #:expand "YES"
+   (iup:hbox ; #:expand "YES"
+    (apply iup:vbox ; #:expand "YES" ;; The heading labels
+	   (append (map (lambda (val)
+			  (iup:label val ; #:expand "HORIZONTAL"
+				     ))
+			(list "Hostname: "
+			      "Uname -a: "
+			      "Disk free: "
+			      "CPU Load: "
+			      "Run duration: "
+			      "Logfile: "))
+		   (iup:label "" #:expand "VERTICAL")))
+    (apply iup:vbox ; #:expand "YES"
+	   (list
+	    ;; NOTE: Yes, the host can change!
+	    (store-label "HostName"
+			 (iup:label (db:test-get-host testdat) #:expand "HORIZONTAL")
+			 (lambda (testdat)(db:test-get-host testdat)))
+	    (store-label "Uname"
+			 (iup:label "                                                   " #:expand "HORIZONTAL")
+			 (lambda (testdat)(db:test-get-uname testdat)))
+	    (store-label "DiskFree"
+			 (iup:label (conc (db:test-get-diskfree testdat)) #:expand "HORIZONTAL")
+			 (lambda (testdat)(conc (db:test-get-diskfree testdat))))
+	    (store-label "CPULoad"
+			 (iup:label (conc (db:test-get-cpuload testdat)) #:expand "HORIZONTAL")
+			 (lambda (testdat)(conc (db:test-get-cpuload testdat))))
+	    (store-label "RunDuration"
+			 (iup:label (conc (db:test-get-run_duration testdat)) #:expand "HORIZONTAL")
+			 (lambda (testdat)(conc (db:test-get-run_duration testdat))))
+	    (store-label "CPULoad"
+			 (iup:label (conc (db:test-get-final_logf testdat)) #:expand "HORIZONTAL")
+			 (lambda (testdat)(conc (db:test-get-final_logf testdat)))))))))
+
+;; use a global for setting the buttons colors
+;;                           state status teststeps
+(define *state-status* (vector #f #f #f))
+(define (update-state-status-buttons testdat)
+  (let* ((state  (db:test-get-state  testdat))
+	 (status (db:test-get-status testdat))
+	 (color  (get-color-for-state-status state status)))
+    ((vector-ref *state-status* 0) state color)
+    ((vector-ref *state-status* 1) status color)))
+
+;;======================================================================
+;; Set fields 
+;;======================================================================
+(define (set-fields-panel test-id testdat)
+  (let ((newcomment #f)
+	(newstatus  #f)
+	(newstate   #f))
+    (iup:frame
+     #:title "Set fields"
+     (iup:vbox
+      (iup:hbox (iup:label "Comment:")
+		(iup:textbox #:action (lambda (val a b)
+					(db:test-set-state-status-by-id *db* test-id #f #f b)
+					(set! newcomment b))
+			     #:value (db:test-get-comment testdat)
+			     #:expand "YES"))
+      (apply iup:hbox
+	     (iup:label "STATE:" #:size "30x")
+	     (let* ((btns  (map (lambda (state)
+				  (let ((btn (iup:button state
+							 #:expand "YES" #:size "70x"
+							 #:action (lambda (x)
+								    (db:test-set-state-status-by-id *db* test-id state #f #f)
+								    (db:test-set-state! testdat state)))))
+				    btn))
+				(list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "KILLED" "KILLREQ"))))
+	       (vector-set! *state-status* 0
+			    (lambda (state color)
+			      (for-each 
+			       (lambda (btn)
+				 (let* ((name     (iup:attribute btn "TITLE"))
+					(newcolor (if (equal? name state) color "192 192 192")))
+				   (if (not (colors-similar? newcolor (iup:attribute btn "BGCOLOR")))
+				       (iup:attribute-set! btn "BGCOLOR" newcolor))))
+			       btns)))
+	       btns))
+      (apply iup:hbox
+	     (iup:label "STATUS:" #:size "30x")
+	     (let* ((btns  (map (lambda (status)
+				  (let ((btn (iup:button status
+							 #:expand "YES" #:size "70x"
+							 #:action (lambda (x)
+								    (db:test-set-state-status-by-id *db* test-id #f status #f)
+								    (db:test-set-status! testdat status)))))
+				    btn))
+				(list  "PASS" "WARN" "FAIL" "CHECK" "n/a" "WAIVED"))))
+	       (vector-set! *state-status* 1
+			    (lambda (status color)
+			      (for-each 
+			       (lambda (btn)
+				 (let* ((name     (iup:attribute btn "TITLE"))
+					(newcolor (if (equal? name status) color "192 192 192")))
+				   (if (not (colors-similar? newcolor (iup:attribute btn "BGCOLOR")))
+				       (iup:attribute-set! btn "BGCOLOR" newcolor))))
+			       btns)))
+	       btns))))))
+
+
+;;======================================================================
+;;
+;;======================================================================
+(define (examine-test db test-id mx1) ;; run-id run-key origtest)
+  (let* ((testdat       (db:get-test-data-by-id db test-id))
+	 (run-id        (if testdat (db:test-get-run_id testdat) #f))
+	 (keydat        (if testdat (keys:get-key-val-pairs db run-id) #f))
+	 (rundat        (if testdat (db:get-run-info db run-id) #f))
+	 (runname       (if testdat (db:get-value-by-header (db:get-row rundat)
+							    (db:get-header rundat)
+							    "runname") #f))
+	 ;(teststeps     (if testdat (db:get-steps-for-test db test-id) #f))
+	 (logfile       "/this/dir/better/not/exist")
+	 (rundir        logfile)
+	 (testfullname  (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
+	 (viewlog    (lambda (x)
+		       (if (file-exists? logfile)
+			   (system (conc "firefox " logfile "&"))
+			   (message-window (conc "File " logfile " not found")))))
+	 (xterm      (lambda (x)
+		       (if (directory-exists? rundir)
+			   (let ((shell (if (get-environment-variable "SHELL") 
+					    (conc "-e " (get-environment-variable "SHELL"))
+					    "")))
+			     (system (conc "cd " rundir 
+					   ";xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")))
+			   (message-window  (conc "Directory " rundir " not found")))))
+	 (refreshdat (lambda ()
+		       (let ((newtestdat (db:get-test-data-by-id db test-id)))
+			 (if newtestdat 
+			     (begin
+			       (mutex-lock! mx1)
+			       (set! testdat newtestdat)
+			       (set! teststeps    (db:get-steps-for-test db test-id))
+			       (set! logfile      (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat)))
+			       (set! rundir       (db:test-get-rundir testdat))
+			       (set! testfullname (db:test-get-fullname testdat))
+			       (mutex-unlock! mx1))
+			     (begin
+			       (db:test-set-testname! testdat "DEAD OR DELETED TEST"))))))
+	 (widgets      (make-hash-table))
+	 (self         #f)
+	 (store-label  (lambda (name lbl cmd)
+			 (hash-table-set! widgets name 
+					  (lambda (testdat)
+					    (let ((newval (cmd testdat))
+						  (oldval (iup:attribute lbl "TITLE")))
+					      (if (not (equal? newval oldval))
+						  (begin
+						    (mutex-lock! mx1)
+						    (iup:attribute-set! lbl "TITLE" newval)
+						    (mutex-unlock! mx1))))))
+			 lbl))
+	 (store-button store-label))
+    (cond
+     ((not testdat)(begin (print "ERROR: bad test info for " test-id)(exit 1)))
+     ((not rundat)(begin (print "ERROR: found test info but there is a problem with the run info for " run-id)(exit 1)))
+     (else
+      ;;  (test-set-status! db run-id test-name state status itemdat)
+      (set! self ; 
+	    (iup:dialog #:close_cb (lambda (a)(exit)) ; #:expand "YES"
+	     #:title testfullname
+	     (iup:vbox ; #:expand "YES"
+               ;; The run and test info
+	       (iup:hbox  ; #:expand "YES"
+		(run-info-panel keydat testdat runname)
+		(test-info-panel testdat store-label widgets))
+	       (host-info-panel testdat store-label)
+	       ;; The controls
+	       (iup:frame #:title "Actions" 
+			  (iup:hbox 
+			   (iup:button "View Log"    #:action viewlog #:size "120x")
+			   (iup:button "Start Xterm" #:action xterm   #:size "120x")
+			   (iup:button "Close"       #:action (lambda (x)(exit)) #:size "120x")))
+	       (set-fields-panel test-id testdat)
+	       (iup:frame 
+		#:title "Test Steps"
+		(let ((stepsdat (iup:label "Test steps ........................................." 
+					   #:expand "YES" 
+					   #:size "200x150"
+					   #:alignment "ALEFT:ATOP")))
+		  (hash-table-set! widgets "Test Steps" (lambda (testdat)
+							  (let* ((currval (iup:attribute stepsdat "TITLE"))
+								 (fmtstr  "~15a~8a~8a~20a")
+								 (newval  (string-intersperse 
+									   (append
+									    (list 
+									     (format #f fmtstr "Stepname" "State" "Status" "Event Time")
+									     (format #f fmtstr "========" "=====" "======" "=========="))
+									    (map (lambda (x)
+										   ;; take advantage of the \n on time->string
+										   (format #f fmtstr
+											   (db:step-get-stepname x)
+											   (db:step-get-state    x)
+											   (db:step-get-status   x)
+											   (time->string 
+											    (seconds->local-time 
+											     (db:step-get-event_time x)))))
+										 (db:get-steps-for-test db test-id)))
+									   "\n")))
+							  (if (not (equal? currval newval))
+								(iup:attribute-set! stepsdat "TITLE" newval)))))
+		  stepsdat)))))
+      (iup:show self)
+      ;; Now start keeping the gui updated from the db
+      (let loop ((i 0))
+	(thread-sleep! 0.1)
+	(refreshdat) ;; update from the db here
+	;(thread-suspend! other-thread)
+	;; update the gui elements here
+	(for-each 
+	 (lambda (key)
+	   ;; (print "Updating " key)
+	   ((hash-table-ref widgets key) testdat))
+	 (hash-table-keys widgets))
+	(update-state-status-buttons testdat)
+	; (iup:refresh self)
+	(iup:main-loop-flush)
+	(if *exit-started*
+	    (set! *exit-started* 'ok)
+	    (loop i)))))))
+
+;;
+;;		    (iup:frame (iup:label (conc "TESTNAME:\n" testfullname) #:expand "YES")))
+;;		   (iup:frame #:title "Actions" #:expand "YES"
+;;			      (iup:hbox ;; the actions box
+;;			       (iup:button "View Log"    #:action viewlog  #:expand "YES")
+;;			       (iup:button "Start Xterm" #:action xterm  #:expand "YES")))
+;;		   (iup:frame #:title "Set fields"
+;;			      (iup:vbox
+;;			       (iup:hbox 
+;;				(iup:vbox ;; the state
+;;				 (iup:label "STATE:" #:size "30x")
+;;				 (let ((lb (iup:listbox #:action (lambda (val a b c)
+;;								   ;; (print val " a: " a " b: " b " c: " c)
+;;								   (set! newstate a))
+;;							#:editbox "YES"
+;;							#:expand "YES")))
+;;				   (iuplistbox-fill-list lb
+;;							 (list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "KILLED" "KILLREQ")
+;;							 currstate)
+;;				   lb))
+;;				(iup:vbox ;; the status
+;;				 (iup:label "STATUS:" #:size "30x")
+;;				 (let ((lb (iup:listbox #:action (lambda (val a b c)
+;;								   (set! newstatus a))
+;;							#:editbox "YES"
+;;							#:value currstatus
+;;							#:expand "YES")))
+;;				   (iuplistbox-fill-list lb
+;;							 (list "PASS" "WARN" "FAIL" "CHECK" "n/a")
+;;							 currstatus)
+;;				   lb)))
+;;			       (iup:hbox (iup:label "Comment:")
+;;					 (iup:textbox #:action (lambda (val a b)
+;;								 (set! currcomment b))
+;;						      #:value currcomment 
+;;						      #:expand "YES"))
+;;			       (iup:button "Apply"
+;;					   #:expand "YES"
+;;					   #:action (lambda (x)
+;;						      (test-set-status! *db* run-id testname newstate newstatus itempath currcomment)))
+;;			       (iup:hbox (iup:button "Apply and close"
+;;						     #:expand "YES"
+;;						     #:action (lambda (x)
+;;								(hash-table-delete! *examine-test-dat* testkey)
+;;								(test-set-status! *db* run-id testname newstate newstatus itempath currcomment)
+;;								(iup:destroy! self)))
+;;					 (iup:button "Cancel and close"
+;;						     #:expand "YES"
+;;						     #:action (lambda (x)
+;;								(hash-table-delete! *examine-test-dat* testkey)
+;;								(iup:destroy! self))))
+;;			       )))
+;;		  (iup:hbox ;; the test steps are tracked here
+;;		   (let ((stepsdat (iup:label "Test steps ........................................." #:expand "YES")))
+;;		     (hash-table-set! widgets "Test Steps" stepsdat)
+;;		     stepsdat)
+;;		   ))))

Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -11,11 +11,11 @@
 
 (use format)
 (require-library iup)
 (import (prefix iup iup:))
 
-;; (use canvas-draw)
+(use canvas-draw)
 
 (use sqlite3 srfi-1 posix regex regex-case srfi-69)
 
 (import (prefix sqlite3 sqlite3:))
 
@@ -26,27 +26,32 @@
 (include "configf.scm")
 (include "process.scm")
 (include "launch.scm")
 (include "runs.scm")
 (include "gui.scm")
+(include "dashboard-tests.scm")
 
 (define help "
 Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
-  version 0.1
+  version 0.2
   license GPL, Copyright Matt Welland 2011
 
 Usage: dashboard [options]
   -h              : this help
+  -run runid      : control run identified by runid
+  -test testid    : control test identified by testid
 
 Misc
   -rows N         : set number of rows
 ")
 
 ;; process args
 (define remargs (args:get-args 
 		 (argv)
 		 (list  "-rows"
+			"-run"
+			"-test"
 			) 
 		 (list  "-h"
 		       )
 		 args:arg-hash
 		 0))
@@ -78,10 +83,11 @@
 (define *num-runs*      10)
 (define *num-tests*     15)
 (define *start-run-offset*  0)
 (define *start-test-offset* 0)
 (define *examine-test-dat* (make-hash-table))
+(define *exit-started* #f)
 
 (define (message-window msg)
   (iup:show
    (iup:dialog
     (iup:vbox 
@@ -100,125 +106,10 @@
 	      items)
     i))
 
 (define (pad-list l n)(append l (make-list (- n (length l)))))
 
-(define (examine-test button-key) ;; run-id run-key origtest)
-  (let ((buttondat     (hash-table-ref/default *buttondat* button-key #f)))
-    ;; (print "buttondat: " buttondat)
-    (if (and buttondat
-	     (vector buttondat)
-	     (vector-ref buttondat 0)
-	     (> (vector-ref buttondat 0) 0)
-	     (vector? (vector-ref buttondat 3))
-	     (> (vector-ref (vector-ref buttondat 3) 0) 0))
-	(let* ((run-id       (vector-ref buttondat 0))
-	       (origtest     (vector-ref buttondat 3))
-	       (run-key      (vector-ref buttondat 4))
-	       (test         (db:get-test-info *db*
-					       run-id
-					       (db:test-get-testname  origtest)
-					       (db:test-get-item-path origtest)))
-	       (rundir       (db:test-get-rundir test))
-	       (test-id      (db:test-get-id     test))
-	       (testname     (db:test-get-testname   test))
-	       (itempath     (db:test-get-item-path test))
-	       (testfullname (runs:test-get-full-path test))
-	       (testkey      (list test-id testname itempath testfullname))
-	       (widgets      (make-hash-table)) ;; put the widgets to update in this hashtable
-	       (currstatus   (db:test-get-status test))
-	       (currstate    (db:test-get-state  test))
-	       (currcomment  (db:test-get-comment test))
-	       (host         (db:test-get-host test))
-	       (cpuload      (db:test-get-cpuload test))
-	       (runtime      (db:test-get-run_duration test))
-	       (logfile      (conc (db:test-get-rundir test) "/" (db:test-get-final_logf test)))
-	       (viewlog      (lambda (x)
-			       (if (file-exists? logfile)
-				   (system (conc "firefox " logfile "&"))
-				   (message-window (conc "File " logfile " not found")))))
-	       (xterm        (lambda (x)
-			       (if (directory-exists? rundir)
-				   (let ((shell (if (get-environment-variable "SHELL") 
-						    (conc "-e " (get-environment-variable "SHELL"))
-						    "")))
-				     (system (conc "cd " rundir 
-						   ";xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")))
-				   (message-window  (conc "Directory " rundir " not found")))))
-	       (newstatus    currstatus)
-	       (newstate     currstate)
-	       (self         #f))
-
-	  (hash-table-set! *examine-test-dat* testkey widgets)
-	  
-	  ;;  (test-set-status! db run-id test-name state status itemdat)
-	  (set! self 
-		(iup:dialog
-		 #:title testfullname
-		 (iup:hbox ;; Need a full height box for all the test steps
-		  (iup:vbox
-		   (iup:hbox 
-		    (iup:frame (iup:label run-key))
-		    (iup:frame (iup:label (conc "TESTNAME:\n" testfullname) #:expand "YES")))
-		   (iup:frame #:title "Actions" #:expand "YES"
-			      (iup:hbox ;; the actions box
-			       (iup:button "View Log"    #:action viewlog  #:expand "YES")
-			       (iup:button "Start Xterm" #:action xterm  #:expand "YES")))
-		   (iup:frame #:title "Set fields"
-			      (iup:vbox
-			       (iup:hbox 
-				(iup:vbox ;; the state
-				 (iup:label "STATE:" #:size "30x")
-				 (let ((lb (iup:listbox #:action (lambda (val a b c)
-								   ;; (print val " a: " a " b: " b " c: " c)
-								   (set! newstate a))
-							#:editbox "YES"
-							#:expand "YES")))
-				   (iuplistbox-fill-list lb
-							 (list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "KILLED" "KILLREQ" "CHECK")
-							 currstate)
-				   lb))
-				(iup:vbox ;; the status
-				 (iup:label "STATUS:" #:size "30x")
-				 (let ((lb (iup:listbox #:action (lambda (val a b c)
-								   (set! newstatus a))
-							#:editbox "YES"
-							#:value currstatus
-							#:expand "YES")))
-				   (iuplistbox-fill-list lb
-							 (list "PASS" "WARN" "FAIL" "CHECK" "n/a")
-							 currstatus)
-				   lb)))
-			       (iup:hbox (iup:label "Comment:")
-					 (iup:textbox #:action (lambda (val a b)
-								 (set! currcomment b))
-						      #:value currcomment 
-						      #:expand "YES"))
-			       (iup:button "Apply"
-					   #:expand "YES"
-					   #:action (lambda (x)
-						      (test-set-status! *db* run-id testname newstate newstatus itempath currcomment)))
-			       (iup:hbox (iup:button "Apply and close"
-						     #:expand "YES"
-						     #:action (lambda (x)
-								(hash-table-delete! *examine-test-dat* testkey)
-								(test-set-status! *db* run-id testname newstate newstatus itempath currcomment)
-								(iup:destroy! self)))
-					 (iup:button "Cancel and close"
-						     #:expand "YES"
-						     #:action (lambda (x)
-								(hash-table-delete! *examine-test-dat* testkey)
-								(iup:destroy! self))))
-			       )))
-		  (iup:hbox ;; the test steps are tracked here
-		   (let ((stepsdat (iup:label "Test steps ........................................." #:expand "YES")))
-		     (hash-table-set! widgets "Test Steps" stepsdat)
-		     stepsdat)
-		   ))))
-	  (iup:show self)
-	  ))))
-
 (define (colors-similar? color1 color2)
   (let* ((c1 (map string->number (string-split color1)))
 	 (c2 (map string->number (string-split color2)))
 	 (delta (map (lambda (a b)(abs (- a b))) c1 c2)))
     (null? (filter (lambda (x)(> x 3)) delta))))
@@ -228,11 +119,11 @@
 	 (header      (db:get-header allruns))
 	 (runs        (db:get-rows   allruns))
 	 (result      '())
 	 (maxtests    0))
     (for-each (lambda (run)
-		(let* ((run-id   (db-get-value-by-header run header "id"))
+		(let* ((run-id   (db:get-value-by-header run header "id"))
 		       (tests    (db-get-tests-for-run *db* run-id testnamepatt itemnamepatt))
 		       (key-vals (get-key-vals *db* run-id)))
 		  (if (> (length tests) maxtests)
 		      (set! maxtests (length tests)))
 		  (set! result (cons (vector run tests key-vals) result))))
@@ -241,22 +132,48 @@
     (set! *allruns* result)
     maxtests))
 
 (define (update-labels uidat)
   (let* ((rown    0)
-	 (lftcol (vector-ref uidat 0))
-	 (maxn   (- (vector-length lftcol) 1)))
-    (let loop ((i 0))
-      (iup:attribute-set! (vector-ref lftcol i) "TITLE" "")
-      (if (< i maxn)
-	  (loop (+ i 1))))
+	 (lftcol  (vector-ref uidat 0))
+	 (numcols (vector-length lftcol))
+	 (maxn    (- numcols 1))
+	 (allvals (make-vector numcols "")))
     (for-each (lambda (name)
 		(if (<= rown maxn)
 		    (let ((labl (vector-ref lftcol rown)))
-		      (iup:attribute-set! labl "TITLE" name)))
+		      (vector-set! allvals rown name)))
 		(set! rown (+ 1 rown)))
-	      (drop *alltestnamelst* *start-test-offset*))))
+	      (if (> (length *alltestnamelst*) *start-test-offset*)
+		  (drop *alltestnamelst* *start-test-offset*)
+		  '()))
+    (let loop ((i 0))
+      (let* ((lbl    (vector-ref lftcol i))
+	     (oldval (iup:attribute lbl "TITLE"))
+	     (newval (vector-ref allvals i)))
+	(if (not (equal? oldval newval))
+	    (iup:attribute-set! lbl "TITLE" newval))
+	(if (< i maxn)
+	    (loop (+ i 1)))))))
+
+(define (get-color-for-state-status state status)
+  (case (string->symbol state)
+    ((COMPLETED)
+     (if (equal? status "PASS")
+	 "70 249 73"
+	 (if (or (equal? status "WARN")
+		 (equal? status "WAIVED"))
+	     "255 172 13"
+	     "223 33 49"))) ;; greenish orangeish redish
+    ((LAUNCHED)         "101 123 142")
+    ((CHECK)            "255 100 50")
+    ((REMOTEHOSTSTART)  "50 130 195")
+    ((RUNNING)          "9 131 232")
+    ((KILLREQ)          "39 82 206")
+    ((KILLED)           "234 101 17")
+    ((NOT_STARTED)      "240 240 240")
+    (else               "192 192 192")))
 
 (define (update-buttons uidat numruns numtests)
   (let* ((runs        (if (> (length *allruns*) numruns)
 			  (take-right *allruns* numruns)
 			  (pad-list *allruns* numruns)))
@@ -297,15 +214,15 @@
 	   ;;           ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration
 	   (set! rundat (vector (make-vector 20 #f) '() (map (lambda (x) "") *keys*))));; 3)))
        (let* ((run      (vector-ref rundat 0))
 	      (testsdat (vector-ref rundat 1))
 	      (key-val-dat (vector-ref rundat 2))
-	      (run-id   (db-get-value-by-header run *header* "id"))
+	      (run-id   (db:get-value-by-header run *header* "id"))
 	      (testnames (delete-duplicates (append *alltestnamelst* 
 						    (map test:test-get-fullname testsdat)))) ;; (take (pad-list testsdat numtests) numtests))
 	      (key-vals (append key-val-dat
-				(list (let ((x (db-get-value-by-header run *header* "runname")))
+				(list (let ((x (db:get-value-by-header run *header* "runname")))
 					(if x x "")))))
 	      (run-key  (string-intersperse key-vals "\n")))
 	 ;; (run-ht  (hash-table-ref/default alldat run-key #f)))
 	 ;; fill in the run header key values
 	 (set! *alltestnamelst* testnames)
@@ -339,24 +256,11 @@
 			   (teststate  (db:test-get-state    test))
 			   (teststart  (db:test-get-event_time test))
 			   (runtime    (db:test-get-run_duration test))
 			   (buttontxt  (if (equal? teststate "COMPLETED") teststatus teststate))
 			   (button     (vector-ref columndat rown))
-			   (color      (case (string->symbol teststate)
-					 ((COMPLETED)
-					  (if (equal? teststatus "PASS")
-					      "70 249 73"
-					      (if (equal? teststatus "WARN")
-						  "255 172 13"
-						  "223 33 49"))) ;; greenish orangeish redish
-					 ((LAUNCHED)         "101 123 142")
-					 ((CHECK)            "255 100 50")
-					 ((REMOTEHOSTSTART)  "50 130 195")
-					 ((RUNNING)          "9 131 232")
-					 ((KILLREQ)          "39 82 206")
-					 ((KILLED)           "234 101 17")
-					 (else "192 192 192")))
+			   (color      (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 (and (equal? teststate "RUNNING")
 		;; 	       (> (- (current-seconds) (+ teststart runtime)) 100)) ;; if test has been dead for more than 100 seconds, call it dead
 			  
@@ -375,11 +279,11 @@
 			    (set! *alltestnamelst* (append *alltestnamelst* (list testfullname))))))
 		    )
 		(set! rown (+ rown 1))))
 	    (let ((xl (if (> (length testnames) *start-test-offset*)
 			  (drop testnames *start-test-offset*)
-			  testnames)))
+			  '()))) ;; testnames)))
 	      (append xl (make-list (- *num-tests* (length xl)) "")))))
 	 (set! coln (+ coln 1))))
      runs)))
 
 (define (mkstr . x)
@@ -411,11 +315,15 @@
 				   (update-search "item-name" val)))
 	   (iup:button "Quit" #:action (lambda (obj)(sqlite3:finalize! *db*)(exit)))
 	   (iup:button "<-  Left" #:action (lambda (obj)(set! *start-run-offset*  (+ *start-run-offset* 1))))
 	   (iup:button "Up     ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0))))
 	   (iup:button "Down   v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1)))))
-	   (iup:button "Right ->" #:action (lambda (obj)(set! *start-run-offset*  (if (> *start-run-offset* 0)(- *start-run-offset* 1) 0))))))
+	   (iup:button "Right ->" #:action (lambda (obj)(set! *start-run-offset*  (if (> *start-run-offset* 0)(- *start-run-offset* 1) 0))))
+	   ;(iup:button "inc rows" #:action (lambda (obj)(set! *num-tests* (+ *num-tests* 1))))
+	   ;(iup:button "dec rows" #:action (lambda (obj)(set! *num-tests* (if (> *num-tests* 0)(- *num-tests* 1) 0))))
+	   )
+	  )
     
     ;; create the left most column for the run key names and the test names 
     (set! lftlst (list (apply iup:vbox 
 			      (map (lambda (x)		
 				     (let ((res (iup:hbox
@@ -468,11 +376,16 @@
 	       (butn       (iup:button "" ;; button-key 
 				       #:size "60x15" 
 				       ;; #:expand "HORIZONTAL"
 				       #:fontsize "10" 
 				       #:action (lambda (x)
-						  (examine-test button-key)))))
+						  (let* ((toolpath (car (argv)))
+							 (buttndat (hash-table-ref *buttondat* button-key))
+							 (test-id  (db:test-get-id (vector-ref buttndat 3)))
+							 (cmd  (conc toolpath " -test " test-id "&")))
+						    (print "Launching " cmd)
+						    (system cmd))))))
 	  (hash-table-set! *buttondat* button-key (vector 0 "100 100 100" button-key #f #f)) 
 	  (vector-set! testvec testnum butn)
 	  (loop runnum (+ testnum 1) testvec (cons butn res))))))
     ;; now assemble the hdrlst and bdylst and kick off the dialog
     (iup:show
@@ -495,24 +408,54 @@
         (set! *num-tests* (string->number (or (args:get-arg "-rows")
 					      (get-environment-variable "DASHBOARDROWS"))))
 	(update-rundat "%" *num-runs* "%" "%"))
     (set! *num-tests* (min (max (update-rundat "%" *num-runs* "%" "%") 8) 20)))
 
-(set! uidat (make-dashboard-buttons *num-runs* *num-tests* dbkeys))
+(define uidat #f)
 ;; (megatest-dashboard)
 
-(define (run-update other-thread)
+(define (run-update mtx1)
   (let loop ((i 0))
-    (thread-sleep! 0.1)
-    (thread-suspend! other-thread)
+    (thread-sleep! 0.05)
+    (mutex-lock! mtx1)
     (update-buttons uidat *num-runs* *num-tests*)
+    (mutex-unlock! mtx1)
+    (iup:main-loop-flush)
+    (mutex-lock! mtx1)
     (update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs*
 		   (hash-table-ref/default *searchpatts* "test-name" "%")
 		   (hash-table-ref/default *searchpatts* "item-name" "%"))
-    (thread-resume! other-thread)
-    (loop (+ i 1))))
-
-(define th2 (make-thread iup:main-loop))
-(define th1 (make-thread (run-update th2)))
-(thread-start! th1)
-(thread-start! th2)
-(thread-join! th2)
+    (mutex-unlock! mtx1)
+    (loop i)))
+
+(define *job* #f)
+
+(cond 
+ ((args:get-arg "-run")
+  (let ((runid (string->number (args:get-arg "-run"))))
+    (if runid
+	(set! *job* (lambda (mx1)
+		      (on-exit (lambda ()
+				 (sqlite3:finalize! *db*)))
+		      (examine-run *db* runid)))
+	(begin
+	  (print "ERROR: runid is not a number " (args:get-arg "-run"))
+	  (exit 1)))))
+ ((args:get-arg "-test")
+    (let ((testid (string->number (args:get-arg "-test"))))
+    (if testid
+	(set! *job* (lambda (mx1)
+		      (examine-test *db* testid mx1)))
+	(begin
+	  (print "ERROR: testid is not a number " (args:get-arg "-test"))
+	  (exit 1)))))
+ (else
+  (set! uidat (make-dashboard-buttons *num-runs* *num-tests* dbkeys))
+  (set! *job* (lambda (mtx1)(run-update mtx1)))))
+
+
+(let* ((mx1 (make-mutex))
+       (th2 (make-thread iup:main-loop))
+       (th1 (make-thread (*job* mx1))))
+  (thread-start! th1)
+  (thread-start! th2)
+  (thread-join! th2))

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -100,11 +100,11 @@
 
 
 (define-inline (db:get-header vec)(vector-ref vec 0))
 (define-inline (db:get-rows   vec)(vector-ref vec 1))
 
-(define (db-get-value-by-header row header field)
+(define (db:get-value-by-header row header field)
   (if (null? header) #f
       (let loop ((hed (car header))
 		 (tal (cdr header))
 		 (n   0))
 	(if (equal? hed field)
@@ -149,11 +149,11 @@
 
 ;; use this one for db-get-run-info
 (define-inline (db:get-row    vec)(vector-ref vec 1))
 
 ;; use (get-value-by-header (db:get-header runinfo)(db:get-row runinfo))
-(define (db-get-run-info db run-id)
+(define (db:get-run-info db run-id)
   (let* ((res      #f)
 	 (keys      (db-get-keys db))
 	 (remfields (list "id" "runname" "state" "status" "owner" "event_time"))
 	 (header    (append (map key:get-fieldname keys)
 			    remfields))
@@ -191,10 +191,16 @@
 (define-inline (db:test-get-rundir       vec) (vector-ref vec 10))
 (define-inline (db:test-get-item-path    vec) (vector-ref vec 11))
 (define-inline (db:test-get-run_duration vec) (vector-ref vec 12))
 (define-inline (db:test-get-final_logf   vec) (vector-ref vec 13))
 (define-inline (db:test-get-comment      vec) (vector-ref vec 14))
+(define-inline (db:test-get-fullname     vec)
+  (conc (db:test-get-testname vec) "/" (db:test-get-item-path vec)))
+
+(define-inline (db:test-set-testname! vec val)(vector-set! vec 2 val))
+(define-inline (db:test-set-state!    vec val)(vector-set! vec 3 val))
+(define-inline (db:test-set-status!   vec val)(vector-set! vec 4 val))
 
 (define (db-get-tests-for-run db run-id . params)
   (let ((res '())
 	(testpatt (if (or (null? params)(not (car params))) "%" (car params)))
 	(itempatt (if (> (length params) 1)(cadr params) "%")))
@@ -213,10 +219,29 @@
 ;; 
 (define (db:delete-test-records db test-id)
   (sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" test-id)
   (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id))
 
+;; set tests with state currstate and status currstatus to newstate and newstatus
+;; use currstate = #f and or currstatus = #f to apply to any state or status respectively
+;; WARNING: SQL injection risk
+(define (db:set-tests-state-status db run-id testnames currstate currstatus newstate newstatus)
+  (for-each (lambda (testname)
+	      (let ((qry (conc "UPDATE tests SET state=?,status=? WHERE "
+					(if currstate  (conc "state='" currstate "' AND ") "")
+					(if currstatus (conc "status='" currstatus "' AND ") "")
+					" testname=? AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
+		;;(print "QRY: " qry)
+		(sqlite3:execute db qry newstate newstatus testname testname)))
+	    testnames))
+	      ;; "('" (string-intersperse tests "','") "')")
+
+(define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment)
+  (if newstate   (sqlite3:execute db "UPDATE tests SET state=?   WHERE id=?;" newstate   test-id))
+  (if newstatus  (sqlite3:execute db "UPDATE tests SET status=?  WHERE id=?;" newstatus  test-id))
+  (if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id)))
+
 (define (db:get-count-tests-running db)
   (let ((res 0))
     (sqlite3:for-each-row
      (lambda (count)
        (set! res count))
@@ -244,11 +269,22 @@
      db 
      "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname=? AND item_path=?;"
      run-id testname item-path)
     res))
 
-;;
+;; Get test data using test_id
+(define (db:get-test-data-by-id db test-id)
+  (let ((res #f))
+    (sqlite3:for-each-row
+     (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)
+       (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)))
+     db 
+     "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;"
+     test-id)
+    res))
+
+
 (define (db:test-set-comment db run-id testname item-path comment)
   (sqlite3:execute 
    db 
    "UPDATE tests SET comment=? WHERE run_id=? AND testname=? AND item_path=?;"
      comment run-id testname item-path))
@@ -277,11 +313,12 @@
 (define-inline (db:step-set-stepname!       vec val)(vector-set! vec 2 val))
 (define-inline (db:step-set-state!          vec val)(vector-set! vec 3 val))
 (define-inline (db:step-set-status!         vec val)(vector-set! vec 4 val))
 (define-inline (db:step-set-event_time!     vec val)(vector-set! vec 5 val))
 
-(define (db-get-test-steps-for-run db test-id)
+;; db-get-test-steps-for-run
+(define (db:get-steps-for-test db test-id)
   (let ((res '()))
     (sqlite3:for-each-row 
      (lambda (id test-id stepname state status event-time)
        (set! res (cons (vector id test-id stepname state status event-time) res)))
      db

ADDED   dboard.scm
Index: dboard.scm
==================================================================
--- /dev/null
+++ dboard.scm
@@ -0,0 +1,524 @@
+;;======================================================================
+;; Copyright 2006-2011, Matthew Welland.
+;; 
+;;  This program is made available under the GNU GPL version 2.0 or
+;;  greater. See the accompanying file COPYING for details.
+;; 
+;;  This program is distributed WITHOUT ANY WARRANTY; without even the
+;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;;  PURPOSE.
+;;======================================================================
+
+(use format)
+(require-library iup)
+(import (prefix iup iup:))
+
+;; (use canvas-draw)
+
+(use sqlite3 srfi-1 posix regex regex-case srfi-69)
+
+(import (prefix sqlite3 sqlite3:))
+
+(include "margs.scm")
+(include "keys.scm")
+(include "items.scm")
+(include "db.scm")
+(include "configf.scm")
+(include "process.scm")
+(include "launch.scm")
+(include "runs.scm")
+(include "gui.scm")
+
+(define help "
+Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
+  version 0.2
+  license GPL, Copyright Matt Welland 2011
+
+Usage: dashboard [options]
+  -h              : this help
+
+Misc
+  -rows N         : set number of rows
+")
+
+;; process args
+(define remargs (args:get-args 
+		 (argv)
+		 (list  "-rows"
+			) 
+		 (list  "-h"
+		       )
+		 args:arg-hash
+		 0))
+
+(if (args:get-arg "-h")
+    (begin
+      (print help)
+      (exit)))
+
+(if (not (setup-for-run))
+    (begin
+      (print "Failed to find megatest.config, exiting") 
+      (exit 1)))
+
+(define *db* (open-db))
+
+(define toplevel #f)
+(define dlg      #f)
+(define max-test-num 0)
+(define *keys*   (get-keys   *db*))
+(define dbkeys   (map (lambda (x)(vector-ref x 0))
+		      (append *keys* (list (vector "runname" "blah")))))
+(define *header*       #f)
+(define *allruns*     '())
+(define *buttondat*    (make-hash-table)) ;; <run-id color text test run-key>
+(define *alltestnames* (make-hash-table)) ;; build a minimalized list of test names
+(define *alltestnamelst* '())
+(define *searchpatts*  (make-hash-table))
+(define *num-runs*      10)
+(define *num-tests*     15)
+(define *start-run-offset*  0)
+(define *start-test-offset* 0)
+(define *examine-test-dat* (make-hash-table))
+
+(define (message-window msg)
+  (iup:show
+   (iup:dialog
+    (iup:vbox 
+     (iup:label msg #:margin "40x40")))))
+
+(define (iuplistbox-fill-list lb items . default)
+  (let ((i 1)
+	(selected-item (if (null? default) #f (car default))))
+    (iup:attribute-set! lb "VALUE" (if selected-item selected-item ""))
+    (for-each (lambda (item)
+		(iup:attribute-set! lb (number->string i) item)
+		(if selected-item
+		    (if (equal? selected-item item)
+			(iup:attribute-set! lb "VALUE" item))) ;; (number->string i))))
+		(set! i (+ i 1)))
+	      items)
+    i))
+
+(define (pad-list l n)(append l (make-list (- n (length l)))))
+
+(define (examine-test button-key) ;; run-id run-key origtest)
+  (let ((buttondat     (hash-table-ref/default *buttondat* button-key #f)))
+    ;; (print "buttondat: " buttondat)
+    (if (and buttondat
+	     (vector buttondat)
+	     (vector-ref buttondat 0)
+	     (> (vector-ref buttondat 0) 0)
+	     (vector? (vector-ref buttondat 3))
+	     (> (vector-ref (vector-ref buttondat 3) 0) 0))
+	(let* ((run-id       (vector-ref buttondat 0))
+	       (origtest     (vector-ref buttondat 3))
+	       (run-key      (vector-ref buttondat 4))
+	       (test         (db:get-test-info *db*
+					       run-id
+					       (db:test-get-testname  origtest)
+					       (db:test-get-item-path origtest)))
+	       (rundir       (db:test-get-rundir test))
+	       (test-id      (db:test-get-id     test))
+	       (testname     (db:test-get-testname   test))
+	       (itempath     (db:test-get-item-path test))
+	       (testfullname (runs:test-get-full-path test))
+	       (testkey      (list test-id testname itempath testfullname))
+	       (widgets      (make-hash-table)) ;; put the widgets to update in this hashtable
+	       (currstatus   (db:test-get-status test))
+	       (currstate    (db:test-get-state  test))
+	       (currcomment  (db:test-get-comment test))
+	       (host         (db:test-get-host test))
+	       (cpuload      (db:test-get-cpuload test))
+	       (runtime      (db:test-get-run_duration test))
+	       (logfile      (conc (db:test-get-rundir test) "/" (db:test-get-final_logf test)))
+	       (viewlog      (lambda (x)
+			       (if (file-exists? logfile)
+				   (system (conc "firefox " logfile "&"))
+				   (message-window (conc "File " logfile " not found")))))
+	       (xterm        (lambda (x)
+			       (if (directory-exists? rundir)
+				   (let ((shell (if (get-environment-variable "SHELL") 
+						    (conc "-e " (get-environment-variable "SHELL"))
+						    "")))
+				     (system (conc "cd " rundir 
+						   ";xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")))
+				   (message-window  (conc "Directory " rundir " not found")))))
+	       (newstatus    currstatus)
+	       (newstate     currstate)
+	       (self         #f))
+
+	  (hash-table-set! *examine-test-dat* testkey widgets)
+	  
+	  ;;  (test-set-status! db run-id test-name state status itemdat)
+	  (set! self 
+		(iup:dialog
+		 #:title testfullname
+		 (iup:hbox ;; Need a full height box for all the test steps
+		  (iup:vbox
+		   (iup:hbox 
+		    (iup:frame (iup:label run-key))
+		    (iup:frame (iup:label (conc "TESTNAME:\n" testfullname) #:expand "YES")))
+		   (iup:frame #:title "Actions" #:expand "YES"
+			      (iup:hbox ;; the actions box
+			       (iup:button "View Log"    #:action viewlog  #:expand "YES")
+			       (iup:button "Start Xterm" #:action xterm  #:expand "YES")))
+		   (iup:frame #:title "Set fields"
+			      (iup:vbox
+			       (iup:hbox 
+				(iup:vbox ;; the state
+				 (iup:label "STATE:" #:size "30x")
+				 (let ((lb (iup:listbox #:action (lambda (val a b c)
+								   ;; (print val " a: " a " b: " b " c: " c)
+								   (set! newstate a))
+							#:editbox "YES"
+							#:expand "YES")))
+				   (iuplistbox-fill-list lb
+							 (list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "KILLED" "KILLREQ")
+							 currstate)
+				   lb))
+				(iup:vbox ;; the status
+				 (iup:label "STATUS:" #:size "30x")
+				 (let ((lb (iup:listbox #:action (lambda (val a b c)
+								   (set! newstatus a))
+							#:editbox "YES"
+							#:value currstatus
+							#:expand "YES")))
+				   (iuplistbox-fill-list lb
+							 (list "PASS" "WARN" "FAIL" "CHECK" "n/a")
+							 currstatus)
+				   lb)))
+			       (iup:hbox (iup:label "Comment:")
+					 (iup:textbox #:action (lambda (val a b)
+								 (set! currcomment b))
+						      #:value currcomment 
+						      #:expand "YES"))
+			       (iup:button "Apply"
+					   #:expand "YES"
+					   #:action (lambda (x)
+						      (test-set-status! *db* run-id testname newstate newstatus itempath currcomment)))
+			       (iup:hbox (iup:button "Apply and close"
+						     #:expand "YES"
+						     #:action (lambda (x)
+								(hash-table-delete! *examine-test-dat* testkey)
+								(test-set-status! *db* run-id testname newstate newstatus itempath currcomment)
+								(iup:destroy! self)))
+					 (iup:button "Cancel and close"
+						     #:expand "YES"
+						     #:action (lambda (x)
+								(hash-table-delete! *examine-test-dat* testkey)
+								(iup:destroy! self))))
+			       )))
+		  (iup:hbox ;; the test steps are tracked here
+		   (let ((stepsdat (iup:label "Test steps ........................................." #:expand "YES")))
+		     (hash-table-set! widgets "Test Steps" stepsdat)
+		     stepsdat)
+		   ))))
+	  (iup:show self)
+	  ))))
+
+(define (colors-similar? color1 color2)
+  (let* ((c1 (map string->number (string-split color1)))
+	 (c2 (map string->number (string-split color2)))
+	 (delta (map (lambda (a b)(abs (- a b))) c1 c2)))
+    (null? (filter (lambda (x)(> x 3)) delta))))
+
+(define (update-rundat runnamepatt numruns testnamepatt itemnamepatt)
+  (let* ((allruns     (db-get-runs *db* runnamepatt numruns *start-run-offset*))
+	 (header      (db:get-header allruns))
+	 (runs        (db:get-rows   allruns))
+	 (result      '())
+	 (maxtests    0))
+    (for-each (lambda (run)
+		(let* ((run-id   (db-get-value-by-header run header "id"))
+		       (tests    (db-get-tests-for-run *db* run-id testnamepatt itemnamepatt))
+		       (key-vals (get-key-vals *db* run-id)))
+		  (if (> (length tests) maxtests)
+		      (set! maxtests (length tests)))
+		  (set! result (cons (vector run tests key-vals) result))))
+	      runs)
+    (set! *header*  header)
+    (set! *allruns* result)
+    maxtests))
+
+(define (update-labels uidat)
+  (let* ((rown    0)
+	 (lftcol (vector-ref uidat 0))
+	 (maxn   (- (vector-length lftcol) 1)))
+    (let loop ((i 0))
+      (iup:attribute-set! (vector-ref lftcol i) "TITLE" "")
+      (if (< i maxn)
+	  (loop (+ i 1))))
+    (for-each (lambda (name)
+		(if (<= rown maxn)
+		    (let ((labl (vector-ref lftcol rown)))
+		      (iup:attribute-set! labl "TITLE" name)))
+		(set! rown (+ 1 rown)))
+	      (if (> (length *alltestnamelst*) *start-test-offset*)
+		  (drop *alltestnamelst* *start-test-offset*)
+		  '())))) ;; *alltestnamelst*))))
+
+(define (update-buttons uidat numruns numtests)
+  (let* ((runs        (if (> (length *allruns*) numruns)
+			  (take-right *allruns* numruns)
+			  (pad-list *allruns* numruns)))
+	 (lftcol      (vector-ref uidat 0))
+	 (tableheader (vector-ref uidat 1))
+	 (table       (vector-ref uidat 2))
+	 (coln        0))
+    (update-labels uidat)
+    (for-each 
+     (lambda (popup)
+       (let* ((test-id  (car popup))
+	      (widgets  (hash-table-ref *examine-test-dat* popup))
+	      (stepslbl (hash-table-ref/default widgets "Test Steps" #f)))
+	 (if stepslbl
+	     (let* ((fmtstr  "~15a~8a~8a~20a")
+		    (newtxt  (string-intersperse 
+			      (append
+			       (list 
+				(format #f fmtstr "Stepname" "State" "Status" "Event Time")
+				(format #f fmtstr "========" "=====" "======" "=========="))
+			       (map (lambda (x)
+				      ;; take advantage of the \n on time->string
+				      (format #f fmtstr
+					      (db:step-get-stepname x)
+					      (db:step-get-state    x)
+					      (db:step-get-status   x)
+					      (time->string 
+					       (seconds->local-time 
+						(db:step-get-event_time x)))))
+				    (db-get-test-steps-for-run *db* test-id)))
+			     "\n")))
+	       (iup:attribute-set! stepslbl "TITLE" newtxt)))))
+     (hash-table-keys *examine-test-dat*))
+    (set! *alltestnamelst* '())
+    (for-each
+     (lambda (rundat)
+       (if (not rundat) ;; handle padded runs
+	   ;;           ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration
+	   (set! rundat (vector (make-vector 20 #f) '() (map (lambda (x) "") *keys*))));; 3)))
+       (let* ((run      (vector-ref rundat 0))
+	      (testsdat (vector-ref rundat 1))
+	      (key-val-dat (vector-ref rundat 2))
+	      (run-id   (db-get-value-by-header run *header* "id"))
+	      (testnames (delete-duplicates (append *alltestnamelst* 
+						    (map test:test-get-fullname testsdat)))) ;; (take (pad-list testsdat numtests) numtests))
+	      (key-vals (append key-val-dat
+				(list (let ((x (db-get-value-by-header run *header* "runname")))
+					(if x x "")))))
+	      (run-key  (string-intersperse key-vals "\n")))
+	 ;; (run-ht  (hash-table-ref/default alldat run-key #f)))
+	 ;; fill in the run header key values
+	 (set! *alltestnamelst* testnames)
+	 (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 *buttondat* (mkstr coln rown) #f)))
+		(if buttondat
+		    (let* ((test       (let ((matching (filter 
+							(lambda (x)(equal? (test:test-get-fullname x) testname))
+							testsdat)))
+					 (if (null? matching)
+					     (vector -1 -1 "" "" "" 0 "" "" 0 "" "" "" 0 "" "")
+					     (car matching))))
+			   ;; (test       (if real-test real-test
+			   (testname   (db:test-get-testname  test))
+			   (itempath   (db:test-get-item-path test))
+			   (testfullname (test:test-get-fullname test))
+			   (teststatus (db:test-get-status   test))
+			   (teststate  (db:test-get-state    test))
+			   (teststart  (db:test-get-event_time test))
+			   (runtime    (db:test-get-run_duration test))
+			   (buttontxt  (if (equal? teststate "COMPLETED") teststatus teststate))
+			   (button     (vector-ref columndat rown))
+			   (color      (case (string->symbol teststate)
+					 ((COMPLETED)
+					  (if (equal? teststatus "PASS")
+					      "70 249 73"
+					      (if (equal? teststatus "WARN")
+						  "255 172 13"
+						  "223 33 49"))) ;; greenish orangeish redish
+					 ((LAUNCHED)         "101 123 142")
+					 ((CHECK)            "255 100 50")
+					 ((REMOTEHOSTSTART)  "50 130 195")
+					 ((RUNNING)          "9 131 232")
+					 ((KILLREQ)          "39 82 206")
+					 ((KILLED)           "234 101 17")
+					 (else "192 192 192")))
+			   (curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR"))
+			   (curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE")))
+		;;       (if (and (equal? teststate "RUNNING")
+		;; 	       (> (- (current-seconds) (+ teststart runtime)) 100)) ;; if test has been dead for more than 100 seconds, call it dead
+			  
+		      (if (not (equal? curr-color color))
+			  (iup:attribute-set! button "BGCOLOR" color))
+		      (if (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 test)
+		      (vector-set! buttondat 4 run-key)
+		      (if (not (hash-table-ref/default *alltestnames* testfullname #f))
+			  (begin
+			    (hash-table-set! *alltestnames* testfullname #t)
+			    (set! *alltestnamelst* (append *alltestnamelst* (list testfullname))))))
+		    )
+		(set! rown (+ rown 1))))
+	    (let ((xl (if (> (length testnames) *start-test-offset*)
+			  (drop testnames *start-test-offset*)
+			  '()))) ;; testnames)))
+	      (append xl (make-list (- *num-tests* (length xl)) "")))))
+	 (set! coln (+ coln 1))))
+     runs)))
+
+(define (mkstr . x)
+  (string-intersperse (map conc x) ","))
+
+(define (update-search x val)
+  ;; (print "Setting search for " x " to " val)
+  (hash-table-set! *searchpatts* x val))
+
+(define (make-dashboard-buttons nruns ntests keynames)
+  (let* ((nkeys   (length keynames))
+	 (runsvec (make-vector nruns))
+	 (header  (make-vector nruns))
+	 (lftcol  (make-vector ntests))
+	 (controls '())
+	 (lftlst  '())
+	 (hdrlst  '())
+	 (bdylst  '())
+	 (result  '())
+	 (i       0))
+    ;; controls (along bottom)
+    (set! controls
+	  (iup:hbox
+	   (iup:textbox #:size "60x15" #:fontsize "10" #:value "%"
+			#:action (lambda (obj unk val)
+				   (update-search "test-name" val)))
+	   (iup:textbox #:size "60x15" #:fontsize "10" #:value "%"
+			#:action (lambda (obj unk val)
+				   (update-search "item-name" val)))
+	   (iup:button "Quit" #:action (lambda (obj)(sqlite3:finalize! *db*)(exit)))
+	   (iup:button "<-  Left" #:action (lambda (obj)(set! *start-run-offset*  (+ *start-run-offset* 1))))
+	   (iup:button "Up     ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0))))
+	   (iup:button "Down   v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1)))))
+	   (iup:button "Right ->" #:action (lambda (obj)(set! *start-run-offset*  (if (> *start-run-offset* 0)(- *start-run-offset* 1) 0))))))
+    
+    ;; create the left most column for the run key names and the test names 
+    (set! lftlst (list (apply iup:vbox 
+			      (map (lambda (x)		
+				     (let ((res (iup:hbox
+						 (iup:label x #:size "40x15" #:fontsize "10") ;;  #:expand "HORIZONTAL")
+						 (iup:textbox #:size "60x15" #:fontsize "10" #:value "%" ;; #:expand "HORIZONTAL"
+							      #:action (lambda (obj unk val)
+									 (update-search x val))))))
+				       (set! i (+ i 1))
+				       res))
+				   keynames))))
+    (let loop ((testnum  0)
+	       (res      '()))
+      (cond
+       ((>= testnum ntests)
+	;; now lftlst will be an hbox with the test keys and the test name labels
+	(set! lftlst (append lftlst (list (apply iup:vbox (reverse res))))))
+       (else
+	(let ((labl  (iup:button "" #:flat "YES" #:size "100x15" #:fontsize "10")))
+	  (vector-set! lftcol testnum labl)
+	  (loop (+ testnum 1)(cons labl res))))))
+    ;; 
+    (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 "60x15" #:fontsize "10" ;; #:expand "HORIZONTAL"
+				)))
+	  (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 "" ;; button-key 
+				       #:size "60x15" 
+				       ;; #:expand "HORIZONTAL"
+				       #:fontsize "10" 
+				       #:action (lambda (x)
+						  (examine-test button-key)))))
+	  (hash-table-set! *buttondat* button-key (vector 0 "100 100 100" button-key #f #f)) 
+	  (vector-set! testvec testnum butn)
+	  (loop runnum (+ testnum 1) testvec (cons butn res))))))
+    ;; now assemble the hdrlst and bdylst and kick off the dialog
+    (iup:show
+     (iup:dialog 
+      #:title "Megatest dashboard"
+      (iup:vbox
+	(apply iup:hbox 
+	       (cons (apply iup:vbox lftlst)
+		     (list 
+		      (iup:vbox
+		       ;; the header
+		       (apply iup:hbox (reverse hdrlst))
+		       (apply iup:hbox (reverse bdylst))))))
+       controls)))
+    (vector lftcol header runsvec)))
+
+(if (or (args:get-arg "-rows")
+	(get-environment-variable "DASHBOARDROWS" ))
+    (begin
+        (set! *num-tests* (string->number (or (args:get-arg "-rows")
+					      (get-environment-variable "DASHBOARDROWS"))))
+	(update-rundat "%" *num-runs* "%" "%"))
+    (set! *num-tests* (min (max (update-rundat "%" *num-runs* "%" "%") 8) 20)))
+
+(set! uidat (make-dashboard-buttons *num-runs* *num-tests* dbkeys))
+;; (megatest-dashboard)
+
+(define (run-update other-thread mtx)
+  (let loop ((i 0))
+    (mutex-lock! mtx)   ;; (thread-suspend! other-thread)
+    (update-buttons uidat *num-runs* *num-tests*)
+    (mutex-unlock! mtx) ;; (thread-resume! other-thread)
+    ;; (thread-sleep! 0.1)
+    ;; (thread-suspend! other-thread)
+    (update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs*
+		   (hash-table-ref/default *searchpatts* "test-name" "%")
+		   (hash-table-ref/default *searchpatts* "item-name" "%"))
+    (thread-resume! other-thread)
+    (thread-sleep! 0.1)
+    (loop (+ i 1))))
+
+(define mtx (make-mutex))
+(define th2 (make-thread iup:main-loop))
+(define th1 (make-thread (run-update th2 mtx)))
+(thread-start! th1)
+(thread-start! th2)
+(thread-join! th2)

Index: keys.scm
==================================================================
--- keys.scm
+++ keys.scm
@@ -35,10 +35,27 @@
 	 ;; (print "qry: " qry)
 	 (sqlite3:for-each-row 
 	  (lambda (key-val)
 	    (set! res (cons key-val res)))
 	  db qry run-id)))
+     keys)
+    (reverse res)))
+
+;; get key val pairs for a given run-id
+;; ( (FIELDNAME1 keyval1) (FIELDNAME2 keyval2) ... )
+(define (keys:get-key-val-pairs db run-id)
+  (let* ((keys (get-keys db))
+	 (res  '()))
+    ;; (print "keys: " keys " run-id: " run-id)
+    (for-each 
+     (lambda (key)
+       (let ((qry (conc "SELECT " (key:get-fieldname key) " FROM runs WHERE id=?;")))
+	 ;; (print "qry: " qry)
+	 (sqlite3:for-each-row 
+	  (lambda (key-val)
+	    (set! res (cons (list (key:get-fieldname key) key-val) res)))
+	  db qry run-id)))
      keys)
     (reverse res)))
 
 (define (keys->keystr keys) ;; => key1,key2,key3,additiona1, ...
   (string-intersperse (map key:get-fieldname keys) ","))

Index: launch.scm
==================================================================
--- launch.scm
+++ launch.scm
@@ -69,14 +69,14 @@
 		   (set! bestsize freespc)))))
 	 (map car disks)))
     best))
 
 (define (create-work-area db run-id test-path disk-path testname itemdat)
-  (let* ((run-info (db-get-run-info db run-id))
+  (let* ((run-info (db:get-run-info db run-id))
 	 (item-path (let ((ip (item-list->path itemdat)))
 		      (if (equal? ip "") "" (conc "/" ip))))
-	 (runname  (db-get-value-by-header (db:get-row run-info)
+	 (runname  (db:get-value-by-header (db:get-row run-info)
 					   (db:get-header run-info)
 					   "runname"))
 	 (key-vals (get-key-vals db run-id))
 	 (key-str  (string-intersperse key-vals "/"))
 	 (dfullp   (conc disk-path "/" key-str "/" runname "/" testname

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -45,15 +45,17 @@
   -showkeys               : show the keys used in this megatest setup
 
 Misc 
   -force                  : override some checks
   -xterm                  : start an xterm instead of launching the test
-  -remove-runs            : remove the data for a run, requires fields, :runname 
+  -remove-runs            : remove the data for a run, requires all fields be specified
+                            and :runname ,-testpatt and -itempatt
                             and -testpatt
-  -testpatt patt          : remove tests matching patt (requires -remove-runs)
   -keepgoing              : continue running until no jobs are \"LAUNCHED\" or
                             \"NOT_STARTED\"
+  -rerun FAIL,WARN...     : re-run if called on a test that previously ran (nullified
+                            if -keepgoing is also specified)
 
 Helpers
   -runstep stepname  ...  : take remaining params as comand and execute as stepname
                             log will be in stepname.log. Best to put command in quotes
   -logpro file            : with -exec apply logpro file to stepname.log, creates
@@ -83,10 +85,11 @@
 			"-setlog"
 			"-set-toplog"
 			"-runstep"
 			"-logpro"
 			"-m"
+			"-rerun"
 			) 
 		 (list  "-h"
 		        "-force"
 		        "-xterm"
 		        "-showkeys"
@@ -117,10 +120,12 @@
 
 ;;======================================================================
 ;; Remove old run(s)
 ;;======================================================================
 
+;; since several actions can be specified on the command line the removal
+;; is done first
 (define (remove-runs)
   (cond
    ((not (args:get-arg ":runname"))
     (print "ERROR: Missing required parameter for -remove-runs, you must specify the run name pattern with :runname patt")
     (exit 2))
@@ -170,15 +175,15 @@
       ;; Each run
       (for-each 
        (lambda (run)
 	 (print "Run: "
 		(string-intersperse (map (lambda (x)
-					   (db-get-value-by-header run header x))
+					   (db:get-value-by-header run header x))
 					 keynames) "/")
 		"/"
-		(db-get-value-by-header run header "runname"))
-	 (let ((run-id (db-get-value-by-header run header "id")))
+		(db:get-value-by-header run header "runname"))
+	 (let ((run-id (db:get-value-by-header run header "id")))
 	   (let ((tests (db-get-tests-for-run db run-id testpatt itempatt)))
 	     ;; Each test
 	     (for-each 
 	      (lambda (test)
 		(format #t
@@ -482,11 +487,12 @@
 		    (begin
 		      (print "Test NOT logged as COMPLETED, (state=" (db:test-get-state testinfo) "), updating result")
 		      (test-set-status! db run-id test-name
 					(if kill-job? "KILLED" "COMPLETED")
 					(if (vector-ref exit-info 1) ;; look at the exit-status
-					    (if (eq? (vector-ref exit-info 2) 0)
+					    (if (and (not kill-job?) 
+						     (eq? (vector-ref exit-info 2) 0))
 						"PASS"
 						"FAIL")
 					    "FAIL") itemdat (args:get-arg "-m")))))
 	      (mutex-unlock! m)
 	      ;; (exec-results (cmd-run->list fullrunscript)) ;;  (list ">" (conc test-name "-run.log"))))
@@ -642,6 +648,14 @@
 
 (if (not *didsomething*)
     (print help))
 
 (if (not (eq? *globalexitstatus* 0))
-    (exit *globalexitstatus*))
+    (if (or (args:get-arg "-runtests")(args:get-arg "-runall"))
+        (begin
+           (print "NOTE: Subprocesses with non-zero exit code detected: " *globalexitstatus*)
+           (exit 0))
+        (case *globalexitstatus*
+         ((0)(exit 0))
+         ((1)(exit 1))
+         ((2)(exit 2))
+         (else (exit 3)))))

Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -246,34 +246,50 @@
 		(if (file-exists? (conc testpath "/testconfig"))
 		    (set! res (cons (last (string-split testpath "/")) res))))
 	      tests)
     res))
 
+(define (runs:can-run-more-tests db)
+  (let ((num-running (db:get-count-tests-running db))
+	(max-concurrent-jobs (config-lookup *configdat* "setup" "max_concurrent_jobs")))
+    ;; (print "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
+    (if (or (not max-concurrent-jobs)
+	    (and max-concurrent-jobs
+		 (string->number max-concurrent-jobs)
+		 (not (>= num-running (string->number max-concurrent-jobs)))))
+	#t
+	(begin 
+	  (print "WARNING: Max running jobs exceeded, current number running: " num-running 
+			 ", max_concurrent_jobs: " max-concurrent-jobs)
+	  #f))))
+  
 (define (run-tests db test-names)
   (let* ((keys        (db-get-keys db))
 	 (keyvallst   (keys->vallist keys #t))
 	 (run-id      (register-run db keys))) ;;  test-name)))
+    ;; on the first pass or call to run-tests set FAILS to NOT_STARTED if
+    ;; -keepgoing is specified
+    (if (and (eq? *passnum* 0)
+	     (args:get-arg "-keepgoing"))
+	(db:set-tests-state-status db run-id test-names #f "FAIL" "NOT_STARTED" "FAIL"))
+    (set! *passnum* (+ *passnum* 1))
     (let loop ((numtimes 0))
       (for-each 
        (lambda (test-name)
-	 (let ((num-running (db:get-count-tests-running db))
-	       (max-concurrent-jobs (config-lookup *configdat* "setup" "max_concurrent_jobs")))
-	   (print "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
-	   (if (or (not max-concurrent-jobs)
-		   (and max-concurrent-jobs
-			(string->number max-concurrent-jobs)
-			(not (>= num-running (string->number max-concurrent-jobs)))))
-	       (run-one-test db run-id test-name keyvallst)
-	       (print "WARNING: Max running jobs exceeded, current number running: " num-running 
-		      ", max_concurrent_jobs: \"" max-concurrent-jobs "\""))))
+	 (if (runs:can-run-more-tests db)
+	     (run-one-test db run-id test-name keyvallst)
+	     ;; add some delay 
+	     (sleep 2)))
        test-names)
+      ;; (run-waiting-tests db)
       (if (args:get-arg "-keepgoing")
 	  (let ((estrem (db:estimated-tests-remaining db run-id)))
 	    (if (> estrem 0)
 		(begin
 		  (print "Keep going, estimated " estrem " tests remaining to run, will continue in 10 seconds ...")
 		  (sleep 10)
+		  (run-waiting-tests db)
 		  (loop (+ numtimes 1)))))))))
 	   
 ;; VERY INEFFICIENT! Move stuff that should be done once up to calling proc
 (define (run-one-test db run-id test-name keyvallst)
   (print "Launching test " test-name)
@@ -305,85 +321,104 @@
 	  (if (args:get-arg "-m")
 	      (db:set-comment-for-run db run-id (args:get-arg "-m")))
 	  (let loop ((itemdat (car allitems))
 		     (tal     (cdr allitems)))
 	    ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
+	    ;; Handle lists of items
 	    (let* ((item-path     (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
 		   (new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))
 		   (new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique
-		   (test-status   #f)
+		   (testdat   #f)
 		   (num-running (db:get-count-tests-running db))
-		   (max-concurrent-jobs (config-lookup *configdat* "setup" "max_concurrent_jobs")))
-	      (print "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
-	      (if (not (or (not max-concurrent-jobs)
-			   (and max-concurrent-jobs
-				(string->number max-concurrent-jobs)
-				(not (>= num-running (string->number max-concurrent-jobs))))))
-		  (print "WARNING: Max running jobs exceeded, current number running: " num-running 
-			 ", max_concurrent_jobs: " max-concurrent-jobs)
+		   (max-concurrent-jobs (config-lookup *configdat* "setup" "max_concurrent_jobs"))
+		   (parent-test (and (not (null? items))(equal? item-path "")))
+		   (single-test (and (null? items) (equal? item-path "")))
+		   (item-test   (not (equal? item-path ""))))
+	      ;; (print "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running)
+	      (if (runs:can-run-more-tests db)
 		  (begin
 		    (let loop2 ((ts (db:get-test-info db run-id test-name item-path)) ;; #f)
 				(ct 0))
 		      (if (and (not ts)
 			       (< ct 10))
 			  (begin
 			    (register-test db run-id test-name item-path)
 			    (db:test-set-comment db run-id test-name item-path "")
-			    ;; (test-set-status! db run-id test-name "NOT_STARTED" "n/a" itemdat "")
-			    ;; (db:set-comment-for-test db run-id test-name item-path "")
-
-			    ;; Move the next line into the test exectute code
-			    ;; (db:delete-test-step-records db run-id test-name) ;; clean out if this is a re-run
-
 			    (loop2 (db:get-test-info db run-id test-name item-path)
 				   (+ ct 1)))
 			  (if ts
-			      (set! test-status ts)
+			      (set! testdat ts)
 			      (begin
 				(print "WARNING: Couldn't register test " test-name " with item path " item-path ", skipping")
 				(if (not (null? tal))
 				    (loop (car tal)(cdr tal)))))))
 		    (change-directory test-path)
 		    ;; this block is here only to inform the user early on
 		    (if (file-exists? runconfigf)
 			(setup-env-defaults db runconfigf run-id *already-seen-runconfig-info*)
 			(print "WARNING: You do not have a run config file: " runconfigf))
-		    ;; (print "run-id: " run-id " test-name: " test-name " item-path: " item-path " test-status: " (test:get-status test-status) " test-state: " (test:get-state test-status))
+		    ;; (print "run-id: " run-id " test-name: " test-name " item-path: " item-path " testdat: " (test:get-status testdat) " test-state: " (test:get-state testdat))
 		    (case (if (args:get-arg "-force")
 			      'NOT_STARTED
-			      (if test-status
-				  (string->symbol (test:get-state test-status))
+			      (if testdat
+				  (string->symbol (test:get-state testdat))
 				  'failed-to-insert))
 		      ((failed-to-insert)
 		       (print "ERROR: Failed to insert the record into the db"))
-		      ((NOT_STARTED COMPLETED) ;; (cadr status is the row id for the run record)
-		       (if (and (equal? (test:get-state test-status)  "COMPLETED")
-				(or (equal? (test:get-status test-status) "PASS")
-				    (equal? (test:get-status test-status) "WARN")
-				    (equal? (test:get-status test-status) "CHECK"))
-				(not (args:get-arg "-force")))
-			   (print "NOTE: Not starting test " new-test-name " as it is state \"COMPLETED\" and status \"" (test:get-status test-status) "\", use -force to override")
-			   (let* ((get-prereqs-cmd (lambda ()
-						     (db-get-prereqs-not-met db run-id waiton))) ;; check before running ....
-				  (launch-cmd      (lambda ()
-						     (launch-test db run-id test-conf keyvallst test-name test-path itemdat)))
-				  (testrundat      (list get-prereqs-cmd launch-cmd)))
-			     (if (or (args:get-arg "-force")
-				     (null? ((car testrundat)))) ;; are there any tests that must be run before this one...
-				 ((cadr testrundat)) ;; this is the line that launches the test to the remote host
-				 (hash-table-set! *waiting-queue* new-test-name testrundat)))))
+		      ((NOT_STARTED COMPLETED)
+		       ;; (print "Got here, " (test:get-state testdat))
+		       (let ((runflag #f))
+			 (cond
+			  ;; i.e. this is the parent test to a suite of items, never "run" it
+			  (parent-test
+			   (set! runflag #f))
+			  ;; -force, run no matter what
+			  ((args:get-arg "-force")(set! runflag #t))
+			  ;; NOT_STARTED, run no matter what
+			  ((equal? (test:get-state testdat) "NOT_STARTED")(set! runflag #t))
+			  ;; not -rerun and PASS, WARN or CHECK, do no run
+			  ((and (or (not (args:get-arg "-rerun"))
+				    (args:get-arg "-keepgoing"))
+				(member (test:get-status testdat) '("PASS" "WARN" "CHECK")))
+			   (set! runflag #f))
+			  ;; -rerun and status is one of the specifed, run it
+			  ((and (args:get-arg "-rerun")
+				(let ((rerunlst (string-split (args:get-arg "-rerun") ","))) ;; FAIL,
+				  (member (test:get-status testdat) rerunlst)))
+			   (set! runflag #t))
+			  ;; -keepgoing, do not rerun FAIL
+			  ((and (args:get-arg "-keepgoing")
+				(member (test:get-status testdat) '("FAIL")))
+			   (set! runflag #f))
+			  ((and (not (args:get-arg "-rerun"))
+				(member (test:get-status testdat) '("FAIL" "n/a")))
+			   (set! runflag #t))
+			  (else (set! runflag #f)))
+			 ;; (print "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat))
+			 (if (not runflag)
+			     (if (not parent-test)
+				 (print "NOTE: Not starting test " new-test-name " as it is state \"COMPLETED\" and status \"" (test:get-status testdat) "\", use -force to override"))
+			     (let* ((get-prereqs-cmd (lambda ()
+						       (db-get-prereqs-not-met db run-id waiton))) ;; check before running ....
+				    (launch-cmd      (lambda ()
+						       (launch-test db run-id test-conf keyvallst test-name test-path itemdat)))
+				    (testrundat      (list get-prereqs-cmd launch-cmd)))
+			       (if (or (args:get-arg "-force")
+				       (null? ((car testrundat)))) ;; are there any tests that must be run before this one...
+				   ((cadr testrundat)) ;; this is the line that launches the test to the remote host
+				   (hash-table-set! *waiting-queue* new-test-name testrundat))))))
 		      ((KILLED) 
 		       (print "NOTE: " new-test-name " is already running or was explictly killed, use -force to launch it."))
 		      ((LAUNCHED REMOTEHOSTSTART RUNNING)  
-		       (if (> (- (current-seconds)(+ (db:test-get-event_time test-status)
-						     (db:test-get-run_duration test-status)))
+		       (if (> (- (current-seconds)(+ (db:test-get-event_time testdat)
+						     (db:test-get-run_duration testdat)))
 			      100) ;; i.e. no update for more than 100 seconds
 			   (begin
-			     (print "WARNING: Test " test-name " appears to be dead.")
+			     (print "WARNING: Test " test-name " appears to be dead. Forcing it to state INCOMPLETE and status STUCK/DEAD")
 			     (test-set-status! db run-id test-name "INCOMPLETE" "STUCK/DEAD" itemdat "Test is stuck or dead"))
 			   (print "NOTE: " test-name " is already running")))
-		      (else       (print "ERROR: Failed to launch test " new-test-name ". Unrecognised state " (test:get-state test-status))))))
+		      (else       (print "ERROR: Failed to launch test " new-test-name ". Unrecognised state " (test:get-state testdat))))))
 	      (if (not (null? tal))
 		  (loop (car tal)(cdr tal)))))))))
 
 (define (run-waiting-tests db)
   (let ((numtries           0)
@@ -392,30 +427,32 @@
     ;; BUG this hack of brute force retrying works quite well for many cases but 
     ;;     what is needed is to check the db for tests that have failed less than
     ;;     N times or never been started and kick them off again
     (let loop ((waiting-test-names (hash-table-keys *waiting-queue*)))
       (cond
+       ((not (runs:can-run-more-tests db))
+	(sleep 2)
+	(loop waiting-test-names))
        ((null? waiting-test-names)
 	(print "All tests launched"))
-       ((> numtries 4)
-	(print "NOTE: Tried launching four times, perhaps run megatest again in a few minutes"))
        (else
 	(set! numtries (+ numtries 1))
 	(for-each (lambda (testname)
-		    (let* ((testdat (hash-table-ref *waiting-queue* testname))
-			   (prereqs ((car testdat)))
-			   (ldb     (if db db (open-db))))
-		      ;; (print "prereqs remaining: " prereqs)
-		      (if (null? prereqs)
-			  (begin
-			    (print "Prerequisites met, launching " testname)
-			    ((cadr testdat))
-			    (hash-table-delete! *waiting-queue* testname)))
-		      (if (not db)
-			  (sqlite3:finalize! ldb))))
+		    (if (runs:can-run-more-tests db)
+			(let* ((testdat (hash-table-ref *waiting-queue* testname))
+			       (prereqs ((car testdat)))
+			       (ldb     (if db db (open-db))))
+			  ;; (print "prereqs remaining: " prereqs)
+			  (if (null? prereqs)
+			      (begin
+				(print "Prerequisites met, launching " testname)
+				((cadr testdat))
+				(hash-table-delete! *waiting-queue* testname)))
+			  (if (not db)
+			      (sqlite3:finalize! ldb)))))
 		  waiting-test-names)
-	(sleep 10) ;; no point in rushing things at this stage?
+	;; (sleep 10) ;; no point in rushing things at this stage?
 	(loop (hash-table-keys *waiting-queue*)))))))
 
 (define (get-dir-up-one dir) 
   (let ((dparts  (string-split dir "/")))
     (conc "/" (string-intersperse 
@@ -430,17 +467,17 @@
 	 (runs        (vector-ref rundat 1)))
     (print "Header: " header)
     (for-each
      (lambda (run)
        (let ((runkey (string-intersperse (map (lambda (k)
-						(db-get-value-by-header run header (vector-ref k 0))) keys) "/")))
-	 (let* ((run-id (db-get-value-by-header run header "id") )
-		(tests  (db-get-tests-for-run db (db-get-value-by-header run header "id") testpatt itempatt))
+						(db:get-value-by-header run header (vector-ref k 0))) keys) "/")))
+	 (let* ((run-id (db:get-value-by-header run header "id") )
+		(tests  (db-get-tests-for-run db (db:get-value-by-header run header "id") testpatt itempatt))
 		(lasttpath "/does/not/exist/I/hope"))
 	   (if (not (null? tests))
 	       (begin
-		 (print "Removing tests for run: " runkey " " (db-get-value-by-header run header "runname"))
+		 (print "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname"))
 		 (for-each
 		  (lambda (test)
 		    (print "  " (db:test-get-testname test) " id: " (db:test-get-id test) " " (db:test-get-item-path test))
 		    (db:delete-test-records db (db:test-get-id test))
 		    (if (> (string-length (db:test-get-rundir test)) 5) ;; bad heuristic but should prevent /tmp /home etc.
@@ -451,17 +488,17 @@
 			  (let ((cmd (conc "rmdir -p " (get-dir-up-one fullpath))))
 			    (print cmd)
 			    (system cmd))
 			  )))
 		  tests)))
-	   (let ((remtests (db-get-tests-for-run db (db-get-value-by-header run header "id"))))
+	   (let ((remtests (db-get-tests-for-run db (db:get-value-by-header run header "id"))))
 	     (if (null? remtests) ;; no more tests remaining
 		 (let* ((dparts  (string-split lasttpath "/"))
 			(runpath (conc "/" (string-intersperse 
 					    (take dparts (- (length dparts) 1))
 					    "/"))))
-		   (print "Removing run: " runkey " " (db-get-value-by-header run header "runname"))
+		   (print "Removing run: " runkey " " (db:get-value-by-header run header "runname"))
 		   (db:delete-run db run-id)
 		   ;; need to figure out the path to the run dir and remove it if empty
 		;;    (if (null? (glob (conc runpath "/*")))
 		;;        (begin
 		;; 	 (print "Removing run dir " runpath)

Index: tests/megatest.config
==================================================================
--- tests/megatest.config
+++ tests/megatest.config
@@ -3,11 +3,11 @@
 fsname TEXT
 datapath TEXT
 
 [setup]
 # exectutable /path/to/megatest
-max_concurrent_jobs 8
+# max_concurrent_jobs 4
 runsdir /tmp/runs
 
 [jobtools]
 # ## launcher launches jobs, the job is managed on the target host
 ## by megatest, comment out launcher to run local

Index: tests/tests/runfirst/main.sh
==================================================================
--- tests/tests/runfirst/main.sh
+++ tests/tests/runfirst/main.sh
@@ -2,8 +2,8 @@
 
 # megatest -step wasting_time :state start :status n/a -m "This is a test step comment"
 # sleep 20
 # megatest -step wasting_time :state end :status $?
 
-$MT_MEGATEST -runstep wasting_time -logpro wasting_time.logpro "sleep 20;echo all done eh?" -m "This is a test step comment"
+$MT_MEGATEST -runstep wasting_time -logpro wasting_time.logpro "sleep 8;echo all done eh?" -m "This is a test step comment"
 
 $MT_MEGATEST -test-status :state COMPLETED :status $? -m "This is a test level comment" -set-toplog the_top_log.html

Index: tests/tests/runfirst/testconfig
==================================================================
--- tests/tests/runfirst/testconfig
+++ tests/tests/runfirst/testconfig
@@ -1,12 +1,8 @@
 [setup]
 runscript main.sh
 
-[requirements]
-diskspace 1M
-memory    1G
-
 [pre-launch-env-vars]
 # These are set before the test is launched on the originating
 # host. This can be used to control remote launch tools, e.g. to
 # to choose the target host, select the launch tool etc.
 SPECIAL_ENV_VAR override with everything after the first space.

ADDED   tests/tests/singletest/main.sh
Index: tests/tests/singletest/main.sh
==================================================================
--- /dev/null
+++ tests/tests/singletest/main.sh
@@ -0,0 +1,9 @@
+#!/bin/bash
+
+# megatest -step wasting_time :state start :status n/a -m "This is a test step comment"
+# sleep 20
+# megatest -step wasting_time :state end :status $?
+
+$MT_MEGATEST -runstep wasting_time -logpro wasting_time.logpro "sleep 5;echo all done eh?" -m "This is a test step comment"
+
+$MT_MEGATEST -test-status :state COMPLETED :status $? -m "This is a test level comment" -set-toplog the_top_log.html

ADDED   tests/tests/singletest/testconfig
Index: tests/tests/singletest/testconfig
==================================================================
--- /dev/null
+++ tests/tests/singletest/testconfig
@@ -0,0 +1,13 @@
+[setup]
+runscript main.sh
+
+[requirements]
+diskspace 1M
+memory    1G
+
+[pre-launch-env-vars]
+# These are set before the test is launched on the originating
+# host. This can be used to control remote launch tools, e.g. to
+# to choose the target host, select the launch tool etc.
+SPECIAL_ENV_VAR override with everything after the first space.
+

ADDED   tests/tests/singletest/wasting_time.logpro
Index: tests/tests/singletest/wasting_time.logpro
==================================================================
--- /dev/null
+++ tests/tests/singletest/wasting_time.logpro
@@ -0,0 +1,15 @@
+;; put stuff here
+
+;; NOTE: This is not legit logpro code!!! 
+
+;; Test for 0=PASS, 1=WARN, >2 = FAIL
+
+;; (define season (get-environment-variable "SEASON"))
+;; 
+;; (exit 
+;;  (case (string->symbol season)
+;;    ((summer) 0)
+;;    ((winter) 1)
+;;    ((fall)   2)
+;;    (else     0)))
+

ADDED   tests/tests/singletest2/main.sh
Index: tests/tests/singletest2/main.sh
==================================================================
--- /dev/null
+++ tests/tests/singletest2/main.sh
@@ -0,0 +1,9 @@
+#!/bin/bash
+
+# megatest -step wasting_time :state start :status n/a -m "This is a test step comment"
+# sleep 20
+# megatest -step wasting_time :state end :status $?
+
+$MT_MEGATEST -runstep wasting_time -logpro wasting_time.logpro "sleep 5;echo all done eh?" -m "This is a test step comment"
+
+$MT_MEGATEST -test-status :state COMPLETED :status $? -m "This is a test level comment" -set-toplog the_top_log.html

ADDED   tests/tests/singletest2/testconfig
Index: tests/tests/singletest2/testconfig
==================================================================
--- /dev/null
+++ tests/tests/singletest2/testconfig
@@ -0,0 +1,14 @@
+[setup]
+runscript main.sh
+
+[requirements]
+diskspace 1M
+memory    1G
+waiton singletest
+
+[pre-launch-env-vars]
+# These are set before the test is launched on the originating
+# host. This can be used to control remote launch tools, e.g. to
+# to choose the target host, select the launch tool etc.
+SPECIAL_ENV_VAR override with everything after the first space.
+

ADDED   tests/tests/singletest2/wasting_time.logpro
Index: tests/tests/singletest2/wasting_time.logpro
==================================================================
--- /dev/null
+++ tests/tests/singletest2/wasting_time.logpro
@@ -0,0 +1,15 @@
+;; put stuff here
+
+;; NOTE: This is not legit logpro code!!! 
+
+;; Test for 0=PASS, 1=WARN, >2 = FAIL
+
+;; (define season (get-environment-variable "SEASON"))
+;; 
+;; (exit 
+;;  (case (string->symbol season)
+;;    ((summer) 0)
+;;    ((winter) 1)
+;;    ((fall)   2)
+;;    (else     0)))
+

Index: tests/tests/sqlitespeed/runscript.rb
==================================================================
--- tests/tests/sqlitespeed/runscript.rb
+++ tests/tests/sqlitespeed/runscript.rb
@@ -6,11 +6,11 @@
 run_and_record('create db',"sqlite3 testing.db << EOF\ncreate table if not exists blah(id INTEGER PRIMARY KEY,name TEXT);\n.q\nEOF","")
 
 # file_size_checker(stepname, filename, minsize, maxsize) - negative means ignore
 # file_size_checker('create db','testing.db',100,-1)
 
-num_records=rand(60) # 0000
+num_records=rand(5) # 0000
 record_step("add #{num_records}","start","n/a")
 status=false
 (0..num_records).each do |i|
   randstring="a;lskdfja;sdfj;alsdfj;aslfdj;alsfja;lsfdj;alsfja;lsjfd;lasfjl;asdfja;slfj;alsjf;asljf;alsjf;lasdjf;lasjf;lasjf;alsjf;lashflkashflkerhflkdsvnlasldhlfaldf"
   # status=system "sqlite3 testing.db \"insert into blah (name) values ('#{randstring}');\""

Index: tests/tests/sqlitespeed/testconfig
==================================================================
--- tests/tests/sqlitespeed/testconfig
+++ tests/tests/sqlitespeed/testconfig
@@ -3,9 +3,7 @@
 
 [requirements]
 waiton    runfirst
 
 [items]
-MANYITEMS [system (env > envfile.txt;ls)]
-# a b c d e f g h i j k l m
-# LSJUNK [system ls]
+MANYITEMS [system (env > envfile.txt;echo aa ab ac ad ae af ag ah ai aj ak al am an ao ap aq ar as at au)]
 

Index: utils/nbfake
==================================================================
--- utils/nbfake
+++ utils/nbfake
@@ -7,6 +7,6 @@
 fi
 
 # Can't always trust $PWD
 CURRWD=`pwd`
 
-ssh -n -f $TARGETHOST "sh -c \"cd $CURRWD; export PATH=$PATH; nohup $* > NBFAKE-`date +%GWW%V.%u_%T` 2>&1 &\""
+ssh -n -f $TARGETHOST "sh -c \"cd $CURRWD;export DISPLAY=$DISPLAY; export PATH=$PATH; nohup $* > NBFAKE-`date +%GWW%V.%u_%T` 2>&1 &\""