Index: dashboard-tests.scm
==================================================================
--- dashboard-tests.scm
+++ dashboard-tests.scm
@@ -10,11 +10,11 @@
 ;;======================================================================
 
 ;;======================================================================
 ;;
 ;;======================================================================
-(define (examine-test db test-id other-thread) ;; run-id run-key origtest)
+(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)
@@ -38,95 +38,122 @@
 			   (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)))
+			       (set! testfullname (db:test-get-fullname testdat))
+			       (mutex-unlock! mx1))
 			     (begin
 			       (sqlite3:finalize! db)
 			       (exit 0))))))
 	 (widgets      (make-hash-table))
 	 (self         #f)
 	 (store-label  (lambda (name lbl cmd)
-			 (hash-table-set! widgets name (lambda ()
-							 (iup:attribute-set! lbl "TITLE" (cmd))))
+			 (hash-table-set! widgets name 
+					  (lambda ()
+					    (let ((newval (cmd))
+						  (oldval (iup:attribute lbl "TITLE")))
+					      (if (not (equal? newval oldval))
+						  (begin
+						    (mutex-lock! mx1)
+						    (iup:attribute-set! lbl "TITLE" (cmd))
+						    (mutex-unlock! mx1))))))
 			 lbl))
-	 (store-button store-label))
+	 (store-button store-label)
+	 ;; Place for new values from the gui
+	 (newstatus     #f)
+	 (newstate      #f)
+	 (newcomment    #f)
+	 
+	 )
     (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
+      (set! self ; 
+	    (iup:dialog #:close_cb (lambda (a)(exit)) ; #:expand "YES"
 	     #:title testfullname
-	     (iup:hbox  #:expand "BOTH" ;; Need a full height box for all the test steps
-	      (iup:vbox #:expand "VERTICAL"
+	     (iup:hbox ; #:expand "YES" ;; Need a full height box for all the test steps
+	      (iup:vbox ; #:expand "YES"
                ;; The run and test info
-	       (iup:hbox  #:expand "BOTH"
-		(iup:frame #:title "Megatest Run Info" #:expand "VERTICAL"
-			   (iup:hbox #:expand "VERTICAL"
-			    (apply iup:vbox #:expand "VERTICAL"
+	       (iup:hbox  ; #:expand "YES"
+		(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"))
+						  (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"))))))
-		(iup:frame #:title "Test Info" #:expand "VERTICAL"
-			   (iup:hbox #:expand "VERTICAL"
-			    (apply iup:vbox #:expand "VERTICAL"
+		(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"))
+						  (iup:label val ; #:expand "HORIZONTAL"
+							     ))
 						(list "Testname: "
 						      "Item path: "
 						      "Current state: "
 						      "Current status: "
-						      "Test comment: "))
+						      "Test comment: "
+						      "Test id: "))
 					   (list (iup:label "" #:expand "VERTICAL"))))
-			    (apply iup:vbox  #:expand "BOTH"
+			    (apply iup:vbox  ; #:expand "YES"
 				   (list 
 				    (iup:label (db:test-get-testname  testdat) #:expand "HORIZONTAL")
 				    (iup:label (db:test-get-item-path testdat) #:expand "HORIZONTAL")
 				    (store-label "teststate" 
 						 (iup:label (db:test-get-state testdat) #:expand "HORIZONTAL")
 						 (lambda ()
 						   (db:test-get-state testdat)))
-				    (let ((lbl   (iup:button (db:test-get-status testdat) #:expand "HORIZONTAL"))
-					  (color (get-color-for-state-status (db:test-get-state testdat)
-									     (db:test-get-status testdat))))
+				    (let ((lbl   (iup:label (db:test-get-status testdat) #:expand "HORIZONTAL")))
 				      (hash-table-set! widgets "teststatus"
 						       (lambda ()
-							 (iup:attribute-set! lbl "BGCOLOR" color)
-							 (db:test-get-status 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 ()
-						   (db:test-get-comment testdat))))))))
+						   (db:test-get-comment testdat)))
+				    (store-label "testid"
+						 (iup:label "TestId                             "
+							    #:expand "HORIZONTAL")
+						 (lambda ()
+						   (db:test-get-id testdat))))))))
 	       ;; The run host info
-	       (iup:frame #:title "Remote host and Test Run Info" #:expand "HORIZONTAL"
-	        (iup:hbox #:expand "HORIZONTAL"
-                 (apply iup:vbox #:expand "VERTICAL" ;; The heading labels
+	       (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"))
+				       (iup:label val ; #:expand "HORIZONTAL"
+						  ))
 				     (list "Hostname: "
 					   "Uname -a: "
 					   "Disk free: "
 					   "CPU Load: "
 					   "Run duration: "
 					   "Logfile: "))
 				(iup:label "" #:expand "VERTICAL")))
-		 (apply iup:vbox #: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 ()(db:test-get-host testdat)))
@@ -143,25 +170,92 @@
 				      (iup:label (conc (db:test-get-run_duration testdat)) #:expand "HORIZONTAL")
 				      (lambda ()(conc (db:test-get-run_duration testdat))))
 			 (store-label "CPULoad"
 				      (iup:label (conc (db:test-get-final_logf testdat)) #:expand "HORIZONTAL")
 				      (lambda ()(conc (db:test-get-final_logf testdat))))))))
-	       ))))
+	       ;; The controls
+	       (iup:frame #:title "Actions" ; #:expand "HORIZONTAL"
+			  (iup:hbox ; #:expand "HORIZONTAL" ;; 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 ; #:expand "HORIZONTAL"
+			   (iup:hbox (iup:label "Comment:")
+				     (iup:textbox #:action (lambda (val a b)
+							     (set! newcomment b))
+						  #:value (db:test-get-comment testdat)
+						  #:expand "YES"
+						  ))
+			   (iup:hbox 
+			    (iup:vbox ; for the state and status controls
+			     (iup:hbox ; #:expand "HORIZONTAL" ;; the state
+			      (iup:label "STATE:" ; #:size "30x" ; #:expand "HORIZONTAL"
+					 )
+			      (let ((lb (iup:listbox #:action (lambda (val a b c)
+								;; (print val " a: " a " b: " b " c: " c)
+								(set! newstate a))
+						     ;; #:editbox "YES"
+						     #:dropdown "YES"
+						     ;#:expand "HORIZONTAL"
+						     )))
+			       (iuplistbox-fill-list lb
+						     (list "Set state" "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "KILLED" "KILLREQ")
+						     "Set state" ) ; (db:test-get-state testdat))
+			       lb))
+			     (iup:hbox ; #:expand "HORIZONTAL" ;; the status
+			      (iup:label "STATUS:" ; #:size "30x" #:expand "HORIZONTAL"
+					 )
+			      (let ((lb (iup:listbox #:action (lambda (val a b c)
+								(set! newstatus a))
+						     ;; #:editbox "YES"
+						     ;; #:value currstatus
+						     #:dropdown "YES"
+						     ;#:expand "HORIZONTAL"
+						     )))
+				(iuplistbox-fill-list lb
+						      (list "Set status" "PASS" "WARN" "FAIL" "CHECK" "n/a")
+						      "Set status" ) ; (db:test-get-status testdat))
+				lb)))
+			    (iup:vbox
+			     (iup:button "Apply"
+					 #:expand "YES"
+					 #:action (lambda (x)
+						    (db:test-set-state-status-by-id *db* test-id newstate newstatus newcomment)
+						    ))
+			     (iup:hbox;  #:expand "YES"
+			      (iup:vbox
+			       (iup:button "Apply and close"
+					; #:expand "YES"
+					   #:action (lambda (x)
+						      (db:test-set-state-status-by-id *db* test-id newstate newstatus newcomment)
+						      (exit))))
+			      (iup:vbox
+			       (iup:button "Cancel and close"
+					; #:expand "YES"
+					   #:action (lambda (x)
+						      (exit)))))))
+			     ))))))
       (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)
+	;(thread-suspend! other-thread)
 	;; update the gui elements here
 	(for-each 
 	 (lambda (key)
 	   ;; (print "Updating " key)
 	   ((hash-table-ref widgets key)))
 	 (hash-table-keys widgets))
-	(thread-resume! other-thread)
-	(loop i))))))
+	;(thread-resume! other-thread)
+	; (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

Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -83,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 
@@ -364,11 +365,13 @@
 				       #:size "60x15" 
 				       ;; #:expand "HORIZONTAL"
 				       #:fontsize "10" 
 				       #:action (lambda (x)
 						  (let* ((toolpath (car (argv)))
-							 (cmd  (conc toolpath " -test " testnum "&")))
+							 (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))))))
@@ -413,26 +416,42 @@
 
 (cond 
  ((args:get-arg "-run")
   (let ((runid (string->number (args:get-arg "-run"))))
     (if runid
-	(set! *job* (lambda (thr)(examine-run *db* 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 (thr)(examine-test *db* testid thr)))
+	(set! *job* (lambda (mx1)
+		      ; (on-exit (lambda ()
+		      ; ;  	 ;;(iup:main-loop-flush)
+		      ;   	 (set! *exit-started* #t)
+		      ;   	 (let loop ((i 0))
+		      ;   	   (if (and (< i 100)
+		      ;   		    (not (eq? *exit-started* 'ok)))
+		      ;   	       (begin
+		      ;   		 (thread-sleep! 0.1)
+		      ;   		 (loop (+ i 1)))))
+		      ;   	 (sqlite3:finalize! *db*)
+		      ;   	 (exit)))
+		      (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 (thr)(run-update thr)))))
 
 
-(let* ((th2 (make-thread iup:main-loop))
-       (th1 (make-thread (*job* th2))))
+(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
@@ -229,10 +229,15 @@
 		;;(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))