Megatest

  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"

					  (else
					   teststate)))
			   (button     (vector-ref columndat rown))
			   (color      (car (gutils: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 (not (equal? curr-color color))
			  #;(iup:attribute-set! button "BGCOLOR" color)
			  (iup:attribute-set! button "FGCOLOR" color))
		      (if (not (equal? curr-title buttontxt))
			  (iup:attribute-set! button "TITLE" (conc "<span weight=\"bold\">"  buttontxt "</span>")))
		      (vector-set! buttondat 0 run-id)
		      (vector-set! buttondat 1 color)
		      (vector-set! buttondat 2 buttontxt)
		      (vector-set! buttondat 3 testdat)
		      (vector-set! buttondat 4 run-key)))
		(set! rown (+ rown 1))))
	    (dboard:tabdat-all-test-names tabdat)))

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

	   ;; 					   (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-empty-runs tabdat) "+HideE" "-HideE"))
	   ;; 					   (mark-for-update tabdat))))
	   (set! hide (iup:button "Hide"
				  #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL"
				  #:action (lambda (obj)
					     (dboard:tabdat-hide-not-hide-set! tabdat #t) ;; (not (dboard:tabdat-hide-not-hide tabdat)))
					     ;; (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-not-hide tabdat) "HideTests" "NotHide"))
					     (iup:attribute-set! hide "FGCOLOR" sel-color)
					     (iup:attribute-set! show "FGCOLOR" nonsel-color)
					     (mark-for-update tabdat))))
	   (set! show (iup:button "Show"
				  #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL"
				  #:action (lambda (obj)
					     (dboard:tabdat-hide-not-hide-set! tabdat #f) ;; (not (dboard:tabdat-hide-not-hide tabdat)))
					     (iup:attribute-set! show "FGCOLOR" sel-color)
					     (iup:attribute-set! hide "FGCOLOR" nonsel-color)
					     (mark-for-update tabdat))))
	   (iup:attribute-set! hide "FGCOLOR" sel-color)
	   (iup:attribute-set! show "FGCOLOR" nonsel-color)
	   ;; (dboard:tabdat-hide-not-hide-button-set! tabdat hideit) ;; never used, can eliminate ...
           (iup:vbox
            (iup:hbox hide show)
            sort-lb))) 
	)

        ;; insert extra widget here

	 (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

	(loop (+ runnum 1) 0 (make-vector ntests) '()))
       (else
	(let* ((button-key (mkstr runnum testnum))
	       (butn       (iup:button
			    "" ;; button-key 
			    #:size (conc cell-width btn-height )
			    #:expand "HORIZONTAL"
			    #:MARKUP "YES"
			    #:fontsize btn-fontsz
			    #:button-cb
			    (lambda (obj a pressed x y btn . rem)
			      ;; (print "pressed= " pressed " x= " x " y= " y " rem=" rem " btn=" btn " string? " (string? btn))
			      (if  (substring-index "3" btn)
				   (if (eq? pressed 1)
				       (let* ((toolpath (car (argv)))