Megatest

	    )))))

;; if there is a submegatest create a button to launch dashboard in that area
;;
(define (submegatest-panel dbstruct keydat testdat runname testconfig)
  (let* ((test-run-dir      (db:test-get-rundir testdat))
	 (subarea           (subrun:get-runarea test-run-dir))
	 (area-exists       (and subarea (common:file-exists? subarea silent: #t)))
	 (target            #f)
	 (runname           #f)
	 (cmd-parts-file (conc test-run-dir "/subrun-command-parts.sexp")))
    (if (file-exists? cmd-parts-file) ;; existance of this file is sufficient to *try* opening a dashboard
	(let* ((cmd-parts      (if (file-exists? cmd-parts-file)
				   (with-input-from-file cmd-parts-file
				     read)
				   '()))
	       (target         (alist-ref "-target" cmd-parts equal?))
	       (runname        (alist-ref "-runname" cmd-parts equal?))
	       (run-area       (alist-ref "-startdir" cmd-parts equal?)))
	  (iup:frame 
	   #:title "Megatest Run Info" ; #:expand "YES"
	   (iup:vbox
	    (iup:button
	     "Launch Dashboard"
	     #:action (lambda (obj)
			(subrun:launch-dashboard test-run-dir)))
	    (iup:button
	     "Launch Dashboard+Filter"
	     #:action (lambda (obj)
			(subrun:launch-dashboard test-run-dir target: target runname: runname))))))
	(iup:vbox ))))

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

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

Usage: dashboard [options]
  -h                    : this help
  -test run-id,test-id  : control test identified by testid
  -skip-version-check   : skip the version check
  -use-db-cache         : access database via cache 
  -target T             : prefill target filter with given target pattern
  -runname R            : prefill runname filter with given runname pattern
  -testpatt P           : prefill testpatt filter with given testpatt              

Misc
  -rows R         : set number of rows
  -cols C         : set number of columns
"))

;;   -server host:port     : connect to host:port instead of db access

			"-run"
			"-test"
                        "-xterm"
			"-debug"
			"-host" 
			"-transport"
                        "-start-dir"
			"-target"   ;; use as filter
			"-runname"  ;; use as filter
			"-testpatt" ;; use as filter
			) 
		 (list  "-h"
			"-use-server"
			"-guimonitor"
			"-main"
			"-v"
			"-q"

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

(define (dboard:runs-tree-txtbox-change tabdat val a b)
  (if b (dboard:tabdat-target-set! tabdat (string-split b "/")))
  (dashboard:update-run-command tabdat))

;; browse runs as a tree. Used in both "Runs" tab and
;; in the runs control panel.
;;
(define (dboard:runs-tree-browser commondat tabdat)
  (let* ((txtbox (iup:textbox
		  #:action (lambda (val a b)
			     (debug:catch-and-dump
			      (lambda ()

				(dboard:runs-tree-txtbox-change tabdat val a b))





			      "command-testname-selector tb action"))
		  #:value (dboard:test-patt->lines
			       (dboard:tabdat-test-patts-use tabdat))
		  #:expand "HORIZONTAL"
		  ;; #:size "10x30"
		  ))
	 (tb
          (iup:treebox
           #:value 0
           #:title "Runs"     ;;  was #:name -- iup 3.19 changed

                        (dboard:tabdat-curr-run-id-set! tabdat run-id)
                        (dboard:tabdat-view-changed-set! tabdat #t))
                      (debug:print-error 5 *default-log-port* "tree-path->run-id returned non-number " run-id))))
              "treebox"))
           ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
           )))
    (dboard:tabdat-runs-tree-set! tabdat tb)
    (if (args:get-arg "-runname")
	(let ((runname (args:get-arg "-runname")))
	  (update-search commondat tabdat "runname" runname)
	  #;(hash-table-set! (dboard:tabdat-searchpatts tabdat) "runname" runname)))
    (if (args:get-arg "-target") ;; 
	(let ((target (args:get-arg "-target")))
	  (iup:attribute-set! txtbox value: target)
	  (dboard:runs-tree-txtbox-change tabdat #f #f target)))
    (iup:detachbox
     (iup:vbox 
      txtbox
      tb
      ))))

;; browse runs as a tree. Used in both "Runs" tab and

	 (i               0)
	 (btn-height      (dboard:tabdat-runs-btn-height runs-dat))
	 (btn-fontsz      (dboard:tabdat-runs-btn-fontsz runs-dat))
	 (cell-width      (dboard:tabdat-runs-cell-width runs-dat)))
    ;; controls (along bottom)
    ;; (set! controls (dboard:make-controls commondat runs-dat))
    
    (if (args:get-arg "-runname")
	(let ((runname (args:get-arg "-runname")))
	  (update-search commondat runs-dat "runname" runname)
	  #;(hash-table-set! (dboard:tabdat-searchpatts tabdat) "runname" runname)))

    ;; create the left most column for the run key names and the test names 
    (set! lftlst
	  (list (iup:hbox
		 (iup:label) ;; (iup:valuator)
		 (apply iup:vbox 
			(map (lambda (x)		
			       (let ((res (iup:hbox
					   #:expand "HORIZONTAL"
					   (iup:label x
						      #:size (conc 40 btn-height)
						      #:fontsize btn-fontsz
						      #:expand "NO") ;; "HORIZONTAL")
					   (iup:textbox
					    #:size (conc 35 btn-height)
					    #:fontsize btn-fontsz
					    #:value (if (and (args:get-arg "-runname")(equal? x "runname"))
							(args:get-arg "-runname") "%")
					    #:expand "NO" ;; "HORIZONTAL"
					    #:action (lambda (obj unk val)
						       ;; each field
						       ;; (field name is "x" var) live updates
						       ;; the search filter as it is typed
						       (dboard:tabdat-target-set! runs-dat #f)
						       ;; ensure fields text boxes are used

			   #:action (lambda (obj val txt)
				      (debug:catch-and-dump
				       (lambda ()
					 ;; (print "obj: " obj " val: " val " unk: " unk)
					 (dboard:tabdat-run-name-set! tabdat txt) ;; (iup:attribute obj "VALUE"))
					 (dashboard:update-run-command tabdat))
				       "command-runname-selector tb action"))
			   #:value (or (args:get-arg "-runname") default-run-name (dboard:tabdat-run-name tabdat))))
	  (lb (iup:listbox #:expand "HORIZONTAL"
			   #:dropdown "YES"
			   #:action (lambda (obj val index lbstate)
				      (debug:catch-and-dump
				       (lambda ()
					 (if (not (equal? val ""))
					     (begin

(define (subrun:subrun-test-initialized? test-run-dir)
  (if (and (common:file-exists? (conc test-run-dir "/subrun-area") )
           (common:file-exists? (conc test-run-dir "/testconfig.subrun") ))
      #t
      #f))

(define (subrun:launch-dashboard test-run-dir #!key (target #f)(runname #f))
  (if (subrun:subrun-test-initialized? test-run-dir)
      (let* ((subarea (subrun:get-runarea test-run-dir))
	     (params  (conc (if target (conc " -target " target) "")
			    (if runname (conc " -runname " runname) ""))))
        (if (and subarea (common:file-exists? subarea))
            (system (conc "cd " subarea ";env -i PATH=$PATH DISPLAY=$DISPLAY HOME=$HOME USER=$USER nbfake dashboard " params))))))

(define (subrun:subrun-removed? test-run-dir)
  (if (subrun:subrun-test-initialized? test-run-dir)
      (let ((flagfile (conc test-run-dir "/subrun.removed")))
        (if (common:file-exists? flagfile)
            #t
            #f))

         ;; swap out testpatt with modified test-patt and add -log
         (switch-alist  (cons
                         (cons "-log" logfile)
                         (map (lambda (item)
                                (if (equal? (car item) "-testpatt")
                                    (cons "-testpatt" testpatt)
                                    item))
                              switch-alist-pre))))
    (with-output-to-file "subrun-command-parts.sexp"
      (lambda ()
	(pp switch-alist)))
    switch-alist))
    ;; note - get precmd from subrun section
    ;;   apply to submegatest commands

(define (subrun:get-log-path test-run-dir log-prefix)
  (let* ((alist (subrun:selector+log-alist test-run-dir log-prefix))
         (res   (alist-ref "-log" alist equal? #f)))