Megatest

			    test-patt
			    states-str
			    statuses-str
			    )))
      (else (set! full-cmd " no valid command ")))
    (iup:attribute-set! cmd-tb "VALUE" full-cmd)))

;; Display the tests as rows of boxes on the test/task pane
;;
(define (dashboard:draw-tests cnv xadj yadj tests-draw-state sorted-testnames)
  (canvas-clear! cnv)
  (canvas-font-set! cnv "Helvetica, -10")
  (let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
	       ((originx originy)             (canvas-origin cnv)))
      ;; (print "originx: " originx " originy: " originy)
      ;; (canvas-origin-set! cnv 0 (- (/ sizey 2)))
      (if (hash-table-ref/default tests-draw-state 'first-time #t)
	  (begin
	    (hash-table-set! tests-draw-state 'first-time #f)
	    (hash-table-set! tests-draw-state 'scalef 8)
	    (hash-table-set! tests-draw-state 'tests-info (make-hash-table))
	    ;; set these 
	    (hash-table-set! tests-draw-state 'test-browse-xoffset 20) ;; (- 0 (* (/ sizex 2) (* 8 xadj))))
	    (hash-table-set! tests-draw-state 'test-browse-yoffset 20))) ;; (- 0 (* (/ sizey 2) (* 8 (- 1 yadj)))))))
      (let* ((scalef (hash-table-ref/default tests-draw-state 'scalef 8))
	     (test-browse-xoffset (hash-table-ref tests-draw-state 'test-browse-xoffset))
	     (test-browse-yoffset (hash-table-ref tests-draw-state 'test-browse-yoffset))
	     (xtorig (+ test-browse-xoffset (* (/ sizex 2) scalef (- 0.5 xadj)))) ;;  (- xadj 1))))
	     (ytorig (+ test-browse-yoffset (* (/ sizey 2) scalef (- yadj 0.5))))
	     (boxw   90)
	     (boxh   25)
	     (gapx   20)
	     (gapy   30)
	     (tests-hash (hash-table-ref tests-draw-state 'tests-info)))
	;; (print "sizex: " sizex " sizey: " sizey " font: " (canvas-font cnv) " originx: " originx " originy: " originy " xtorig: " xtorig " ytorig: " ytorig " xadj: " xadj " yadj: " yadj)
	(let loop ((hed (car (reverse sorted-testnames)))
		   (tal (cdr (reverse sorted-testnames)))
		   (llx xtorig)
		   (lly ytorig)
		   (urx (+ xtorig boxw))
		   (ury (+ ytorig boxh)))
	  ; (print "hed " hed " llx " llx " lly " lly " urx " urx " ury " ury)
	  (canvas-text! cnv (+ llx 5)(+ lly 5) hed) ;; (conc testname " (" xtorig "," ytorig ")"))
	  (canvas-rectangle! cnv llx urx lly ury)
	  (hash-table-set! tests-hash hed (list llx urx (- sizey ury)(- sizey lly))) ;; NB// Swap ury and lly
	  (if (not (null? tal))
	      ;; leave a column of space to the right to list items
	      (let ((have-room 
		     (if #t ;; put "auto" here where some form of auto rearanging can be done
			 (> (* 3 (+ boxw gapx)) (- urx xtorig))
			 (< urx (- sizex boxw gapx boxw)))))  ;; is there room for another column?
		(loop (car tal)

	 (update-keyvals (lambda ()
			   (let ((targ (map (lambda (x)
					      (iup:attribute x "VALUE"))
					    (car (dashboard:update-target-selector key-listboxes)))))
			     (dboard:data-set-target! *data* targ)
			     (if updater-for-runs (updater-for-runs))
			     (dashboard:update-run-command))))
	 (tests-draw-state (make-hash-table)) ;; use for keeping state of the test canvas
	 (test-patterns-textbox  #f))
    (hash-table-set! tests-draw-state 'first-time #t)
    (hash-table-set! tests-draw-state 'scalef 8)
    (tests:get-full-data test-names test-records '())
    (set! sorted-testnames (tests:sort-by-priority-and-waiton test-records))
    
    ;; refer to *keys*, *dbkeys* for keys
    (iup:vbox

					       ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
				(system cmd))))))

     (iup:split
       #:orientation "HORIZONTAL"
       
       (iup:split

	#:value 300

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

	 (iup:frame
	  #:title "Runname"
	   (let* ((default-run-name (conc "ww" (seconds->work-week/day (current-seconds))))
		  (tb (iup:textbox #:expand "HORIZONTAL"
				   #:action (lambda (obj val txt)
					      ;; (print "obj: " obj " val: " val " unk: " unk)
					      (dboard:data-set-run-name! *data* txt) ;; (iup:attribute obj "VALUE"))

	 (iup:frame
	  #:title "SELECTORS"
	  (iup:vbox
	   ;; Text box for test patterns
	   (iup:frame
	    #:title "Test patterns (one per line)"
	   (let ((tb (iup:textbox #:action (lambda (val a b)
				    (dboard:data-set-test-patts!
				     *data*
				     (dboard:lines->test-patt b))
				    (dashboard:update-run-command))
			 #:value (dboard:test-patt->lines
				  (dboard:data-get-test-patts *data*))
			 #:expand "YES"
				  #:multiline "YES")))
	     (set! test-patterns-textbox tb)
	     tb))
	   (iup:frame
	    #:title "Target"
	    ;; Target selectors
	    (apply iup:hbox
		   (let* ((dat      (dashboard:update-target-selector key-listboxes action-proc: update-keyvals))
			  (key-lb   (car dat))
			  (combos   (cadr dat)))

	(iup:frame
	 #:title "Tests and Tasks"
	 (iup:canvas #:action (make-canvas-action
			       (lambda (cnv xadj yadj)
				 ;; (print "cnv: " cnv " x: " x " y: " y)
				 (dashboard:draw-tests cnv xadj yadj tests-draw-state sorted-testnames)))
		    ;; Following doesn't work 
		    ;; #:wheel-cb (make-canvas-action
		    ;;           (lambda (cnv xadj yadj)
		    ;;    	 ;; (print "cnv: " cnv " x: " x " y: " y)
		    ;;    	 (dashboard:draw-tests cnv xadj yadj tests-draw-state sorted-testnames)))
		     #:size "150x150"
		     #:expand "YES"
		     #:scrollbar "YES"
		     #:posx "0.5"
		    #:posy "0.5"
		    #:button-cb (lambda (obj btn pressed x y status)
				  (let ((tests-info (hash-table-ref tests-draw-state  'tests-info)))
				    ;; (print "x\ty\tllx\tlly\turx\tury")
				    (for-each (lambda (test-name)
						(let* ((rec-coords (hash-table-ref tests-info test-name))
						       (llx        (list-ref rec-coords 0))
						       (urx        (list-ref rec-coords 1))
						       (lly        (list-ref rec-coords 2))
						       (ury        (list-ref rec-coords 3)))
						  ;; (print x "\t" y "\t" llx "\t" lly "\t" urx "\t" ury "\t" test-name " "
						  (if (and (> x llx)
							   (> y lly)
							   (< x urx)
							   (< y ury))
						      (let ((patterns (string-split (iup:attribute test-patterns-textbox "VALUE"))))
							(if (not (member test-name patterns))
							    (let* ((newpatt (string-intersperse (cons test-name patterns) "\n")))
							      (iup:attribute-set! test-patterns-textbox "VALUE" newpatt)
							      (dboard:data-set-test-patts! *data* (dboard:lines->test-patt newpatt))
							      (dashboard:update-run-command)))))))
					      (hash-table-keys tests-info)))))))
      ;; (print "obj: " obj " btn: " btn " pressed: " pressed " x: " x " y: " y " status: " status))
     
       (iup:frame
	#:title "Logs" ;; To be replaced with tabs
	(let ((logs-tb (iup:textbox #:expand "YES"
				    #:multiline "YES")))
	  (dboard:data-set-logs-textbox! *data* logs-tb)
	 logs-tb))))))

  

;; (trace dashboard:populate-target-dropdown
;;        common:list-is-sublist)
;; 
;;       ;; key1 key2 key3 ...
;;       ;; target entry (wild cards allowed)

;; Convert to and from list of lines (for a text box)
;; "," => "\n"
(define (dboard:test-patt->lines test-patt)
  (string-substitute (regexp ",") "\n" test-patt))

(define (dboard:lines->test-patt lines)
  (string-substitute (regexp "\n") "," lines #t))


;;======================================================================
;; P R O C E S S   R U N S
;;======================================================================

;; MOVE THIS INTO *data*