ADDED   dashboard-new-runs-view.scm
Index: dashboard-new-runs-view.scm
==================================================================
--- /dev/null
+++ dashboard-new-runs-view.scm
@@ -0,0 +1,364 @@
+;;======================================================================
+;; Extracting the data to display for runs
+;;
+;; This needs to be re-entrant such that it does one column per call
+;; on the zeroeth call update runs data
+;; on each subsequent call update one run (configurable - could do two, three ... or update until tdelta exceeded
+;; on last run reset to zeroeth
+;;
+;;   1. select with run filters; area, target, runname, runstate, runstatus, starttime, duration
+;;       - put this information into two data structures:
+;;         a. hash of area/target/runname => runstruct #< ordernun, id, area, target, runname, state,
+;;                                                        status, starttime, duration, non-deleted testcount>
+;;            ordernum reflects order as received from sql query
+;;         b. sparsevec of id => runstruct
+;;   2. for each run in runshash ordered by ordernum do:
+;;         retrieve data since last update for that run
+;;         if there is a deleted test - retrieve full data
+;;         if there are non-deleted tests register this run in the columns sparsevec
+;;         if this is the zeroeth column regenerate the rows sparsevec
+;;         if this column is in the visible zone update visible cells
+;;
+;; Other factors:
+;;   1. left index handling:
+;;       - add test/itempaths to left index as discovered, re-order and
+;;         update row -> test/itempath mapping on each read run
+;;======================================================================
+
+;; runs is <vec header runs>
+;;   get ALL runs info
+;;   update rdat-targ-run-id
+;;   update rdat-runs
+;;
+(define (dashboard:update-runs-data rdat)
+  (let* ((tb               (dboard:rdat-runs-tree rdat))
+	 (targ-sql-filt    (dboard:rdat-targ-sql-filt    rdat))
+	 (runname-sql-filt (dboard:rdat-runname-sql-filt rdat))
+	 (state-sql-filt   (dboard:rdat-run-state-sql-filt   rdat))
+	 (status-sql-filt  (dboard:rdat-run-status-sql-filt  rdat))
+	 ;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
+	 (data             (rmt:simple-get-runs runname-sql-filt #f #f targ-sql-filt #f))
+	 (numruns          (length data)))
+    ;; store in the runsbynum vector
+    (dboard:rdat-runsbynum-set! rdat (list->vector data))
+    ;; update runs       id              => runrec
+    ;; update targ-runid target/runname  => run-id
+    (for-each
+     (lambda (runrec)
+       (let* ((run-id (simple-run-id runrec))
+	      (full-targ-runname (conc (simple-run-target runrec) "/"
+				       (simple-run-runname runrec))))
+	 ;; (debug:print 0 *default-log-port* "Update run  " run-id)
+	 (sparse-vector-set! (dboard:rdat-runs rdat) run-id runrec)
+	 (hash-table-set! (dboard:rdat-targ-runid rdat) full-targ-runname run-id)
+	 (tree:add-node tb "Runs" (string-split full-targ-runname "/"))
+	 ))
+     data)
+    numruns))
+
+;;======================================================================
+;; The "new" runs browser, this one sets up the view and registers the
+;; updater
+;;
+(define (dashboard:runs-browse commondat tabdat #!key (tab-num 5))
+  (let* ((rdat     (make-dboard:rdat))
+	 (runsmtx  (dboard:runs-new-matrix commondat rdat))
+	 (itemsmtx (dboard:runs-new-matrix commondat rdat)))
+    (dboard:rdat-runs-mtx-set! rdat runsmtx)
+    (dboard:rdat-items-mtx-set! rdat itemsmtx)
+    (dboard:commondat-add-updater
+     commondat
+     (lambda ()
+       (dashboard:new-runs-updater commondat tabdat rdat))
+     tab-num: tab-num)
+    (iup:split
+     #:orientation "VERTICAL"
+     #:value 100
+     #:shrink "YES"
+     (iup:vbox
+      (dboard:runs-tree-new-view-browser commondat rdat))
+     (iup:split
+      #:orientation "VERTICAL"
+      #:value 100
+      (iup:vbox runsmtx)
+      (iup:vbox
+       (iup:split
+	#:orientation "VERTICAL"
+	#:value 500
+	itemsmtx
+	(dboard:test-info-matrix commondat rdat)
+	))))))
+
+(define (dashboard:new-runs-updater commondat tabdat rdat)
+  (let* ((runnum           (dboard:rdat-runnum          rdat))
+	 (start-time       (current-milliseconds))
+	 (tot-runs         #f))
+    (if (eq? runnum 0)(dashboard:update-runs-data rdat))
+    (set! tot-runs (vector-length (dboard:rdat-runsbynum rdat)))
+    (let loop ((rn   runnum))
+      (if (and (< (- (current-milliseconds) start-time) 250)
+	       (< rn tot-runs))
+	  (let* ((newrn (if (>= runnum (vector-length (dboard:rdat-runsbynum rdat)))
+			    0 ;; start over
+			    (+ rn 1)))) ;; (+ runnum 1)))
+	    (dashboard:update-run-data rn rdat)
+	    (dboard:rdat-runnum-set! rdat newrn)
+	    (if (> newrn 0)
+		(loop newrn)))))
+    (if (>=  (dboard:rdat-runnum rdat) tot-runs)
+	(dboard:rdat-runnum-set! rdat 0))
+    ;; (dboard:rdat-runnum-set! rdat rn))) ;; not needed as it is set above
+    ;; (dboard:rdat-last-update-set! rdat (- (current-seconds) 10))
+    (dashboard:update-new-runs-view-runs-matrix commondat rdat)
+    '()))
+
+;; NOTE: runnum is NOT the run-id, it is a pointer into the runsbynum vector
+;;
+(define (dashboard:update-run-data runnum rdat)
+  (let* ((curr-time            (current-seconds))
+	 (runrec               (vector-ref (dboard:rdat-runsbynum rdat) runnum))
+	 (run-id               (simple-run-id runrec))
+	 (last-update          (sparse-vector-ref (dboard:rdat-last-updates rdat) run-id))
+	 ;; filters
+	 (testname-sql-filt    (dboard:rdat-testname-sql-filt    rdat))
+	 ;; (itempath-sql-filt    (dboard:rdat-itempath-sql-filt    rdat))
+	 (test-state-sql-filt  (dboard:rdat-test-state-sql-filt  rdat))  ;; not used yet
+	 (test-status-sql-filt (dboard:rdat-test-status-sql-filt rdat))  ;; not used yet
+	 (tests                (rmt:get-tests-for-run-state-status run-id
+						      testname-sql-filt
+						      last-update                ;; last-update
+						      )))
+    ;; (debug:print 0 *default-log-port* "tests: " tests)
+    (sparse-vector-set! (dboard:rdat-last-updates rdat) run-id (- curr-time 1))
+    (sparse-vector-set! (dboard:rdat-run-tests rdat) run-id
+			(delete-duplicates
+			 (append tests (sparse-vector-ref (dboard:rdat-run-tests rdat) run-id))
+			 (lambda (a b)
+			   (eq? (vector-ref a 0)(vector-ref b 0))))) ;; de-duplicate based on test id
+    #;(debug:print 0 *default-log-port* "Got " (length tests) " tests for run-id "
+		 run-id " testname-sql-filt " testname-sql-filt " and last-update " last-update
+		 " first test info: " tests) ;; (if (not (null? tests))(car tests) '()))
+    (length tests)))
+
+;; NB// start at 1.
+;;
+(define (dashboard:get-row-num mtrx rownames tname)
+  (or (hash-table-ref/default rownames tname #f)
+      (let* ((numentries (hash-table-size rownames))
+	     (nextnum    (+ numentries 1)))
+	(hash-table-set! rownames tname nextnum)
+	(iup:attribute-set! mtrx (conc nextnum ":0") tname)
+	nextnum)))
+
+(define (dashboard:update-new-runs-view-runs-matrix commondat rdat)
+  (let* ((run-tests-data (dboard:rdat-run-tests rdat)) ;; from dbmod.scm (define-record simple-run target id runname state status owner event_time)
+	 (run-tests-mtx  (dboard:rdat-runs-mtx  rdat))
+	 (runs-by-num    (dboard:rdat-runsbynum rdat)) ;; this is the sequence num
+	 (num-runs       (vector-length runs-by-num))
+	 )
+    (debug:print 0 *default-log-port* "num-runs: " num-runs)
+    (let loop ((col-num 1))
+      (let* ((runrec    (vector-ref runs-by-num (- col-num 1)))
+	     (run-id    (simple-run-id runrec))
+	     (target    (simple-run-target runrec))
+	     (runname   (simple-run-runname runrec))
+	     (vert-targ (string-translate (conc target "/" runname) "/" "\n"))
+	     (run-tests (sparse-vector-ref run-tests-data run-id))
+	     (changed   #f))  ;; manage redraws on a column by column basis
+	(debug:print 0 *default-log-port* "run-tests: " run-tests)
+	(if (null? run-tests) ;; empty run
+	    (if (< col-num num-runs) ;; NOT CORRECT
+		(loop (+ col-num)))
+	    (begin
+	      (set! changed (dcommon:modifiy-if-different ;; set the col header
+			     run-tests-mtx
+			     (conc "0:" col-num)
+			     vert-targ
+			     changed))
+	      (let testloop ((inum    0)
+			     (tail    run-tests))
+		(let* ((test-dat   (car tail))
+		       (tname      (db:test-get-testname test-dat))
+		       (state      (db:test-get-state    test-dat))
+		       (status     (db:test-get-status   test-dat))
+		       (item-path  (db:test-get-item-path test-dat))
+		       (color      (gutils:get-color-for-state-status state status))
+		       (is-deleted (equal? state "DELETED"))
+		       (row-num    (if is-deleted
+				       #f
+				       (dashboard:get-row-num run-tests-mtx
+							      (dboard:rdat-rownames rdat) tname)))
+		       (cell-name (conc row-num ":" col-num)))
+		  (if (or (not is-deleted)
+			  (equal? item-path ""))
+		      (begin
+ 			(set! changed (dcommon:modifiy-if-different 
+ 				       run-tests-mtx
+ 				       (conc "BGCOLOR" row-num ":" col-num)
+ 				       (car color)
+ 				       changed))
+			(set! changed (dcommon:modifiy-if-different 
+ 				       run-tests-mtx
+ 				       cell-name
+ 				       (cadr color)
+ 				       changed))))
+		  (if (not (null? (cdr tail)))
+		      (testloop (+ inum 1)(cdr tail))
+		      (begin
+			(iup:attribute-set! run-tests-mtx (conc "C" col-num) "REDRAW")
+			(if (< col-num num-runs)
+			    (loop (+ col-num 1)))))))))))))
+
+(define (dboard:runs-new-matrix commondat rdat)
+  (iup:matrix
+   #:alignment1 "ALEFT"
+   #:expand "YES" ;; "HORIZONTAL"
+   #:scrollbar "YES"
+   #:numcol 100
+   #:numlin 200
+   #:numcol-visible 3 ;; (min 8)
+   #:numlin-visible 10
+   #:widthdef 20
+   #:click-cb
+   (lambda (obj row col status)
+     (let* ((cell (conc row ":" col)))
+       #f))
+   ))
+
+;; run info, test info
+(define (dboard:test-info-matrix commondat rdat)
+  (let* ((run-fields
+	  '(("Run Info"  . 1)
+	    ("Fields"    . 2)
+	    ("Target"    . 3)
+	    ("Runname"   . 4)
+	    ("Run-id"    . 5)
+	    ("Run-date"  . 6)))
+	 (test-fields
+	  '(("Test Info" . 1)
+	    ("Testname"  . 2)
+	    ("Item path" . 3)
+	    ("State"     . 4)
+	    ("Status"    . 5)
+	    ("Comment"   . 6)
+	    ("Test-id"   . 7)
+	    ("Test-date" . 8)))
+	 (test-meta-fields
+	  '(("Test Meta Data" . 1)
+	    ("Author"    . 2)
+	    ("Owner"     . 3)
+	    ("Reviewed"  . 4)
+	    ("Tags"      . 5)
+	    ("Description" . 6)))
+	 (remhost-run-info-fields
+	  '(("Host/run info" . 1)
+	    ("Hostname"  . 2)
+	    ("Disk free" . 3)
+	    ("CPU Load"  . 4)
+	    ("Run duration" . 5)
+	    ("Logfile"   . 6)
+	    ("Process ID" . 7)
+	    ("Machine info" . 8)))
+	 (mk-matrix (lambda (cfgdat)
+		      (let ((mtx (iup:matrix
+				  #:alignment1 "ALEFT"
+				  ;; #:expand "YES" ;; "HORIZONTAL"
+				  #:scrollbar "YES"
+				  #:numcol 1
+				  #:numlin (length cfgdat)
+				  #:numcol-visible 1 ;; (min 8)
+				  #:numlin-visible (length cfgdat)
+				  #:widthdef 50
+				  #:width0 50
+				  #:click-cb
+				  (lambda (obj row col status)
+				    (let* ((cell (conc row ":" col)))
+				      #f)))))
+			(for-each (lambda (finfo)
+				    (match finfo
+				      ((fieldname . rownum)
+				       (iup:attribute-set! mtx (conc rownum":0") fieldname))
+				      (else (debug:print 0 *default-log-port* "ERROR: bad finfo "finfo))))
+				  cfgdat)
+			mtx)))
+	 (runmtx  (mk-matrix run-fields))
+	 (testmtx (mk-matrix test-fields))
+	 (metamtx (mk-matrix test-meta-fields))
+	 (remhostmtx (mk-matrix remhost-run-info-fields)))
+    ;; (dboard:rdat-runs-mtx-set! rdat runmtx)
+    ;; (dboard:rdat-items-mtx-set! rdat testmtx)
+    ;; (
+    (iup:vbox
+     #:expandchildren #t
+     #:expand #f
+     runmtx testmtx
+     metamtx remhostmtx
+     )))
+
+;; browse runs as a tree. Used in both "Runs" tab and
+;; in the runs control panel.
+;;
+;;  THIS IS THE NEW ONE
+;;
+(define (dboard:runs-tree-new-view-browser commondat rdat)
+  (let* ((txtbox (iup:textbox
+		  #:action (lambda (val a b)
+			     (debug:catch-and-dump
+			      (lambda ()
+				;; for the Runs view we put the list
+				;; of keyvals into tabdat target for
+				;; the Run Controls we put then update
+				;; the run-command
+				(if b (dboard:rdat-targ-sql-filt-set! rdat
+								 (string-split b "/")))
+				#;(dashboard:update-run-command tabdat))
+			      "command-testname-selector tb action"))
+		  ;; #:value (dboard:test-patt->lines  ;; This seems like it was wrong, BUG in code where it was copied from?
+	          ;;		   (dboard:tabdat-test-patts-use tabdat))
+		  #:expand "HORIZONTAL"
+		  ;; #:size "10x"
+		  ))
+	 (tb
+          (iup:treebox
+           #:value 0
+           #:title "Runs"     ;;  was #:name -- iup 3.19 changed
+			      ;;  this... "Changed: [DEPRECATED
+			      ;;  REMOVED] removed the old attribute
+			      ;;  NAMEid from IupTree to avoid
+			      ;;  conflict with the common attribute
+			      ;;  NAME. Use the TITLEid attribute."
+           #:expand "YES"
+           #:addexpanded "YES"
+           #:size "120x"
+           #:selection-cb
+           (lambda (obj id state)
+             (debug:catch-and-dump
+              (lambda ()
+                (let* ((run-path (tree:node->path obj id))
+                       (run-id    (new-tree-path->run-id rdat (cdr run-path))))
+                  ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ??
+                  ;; done below when run-id is a number
+                  (dboard:rdat-targ-sql-filt-set! rdat (cdr run-path)) ;; (print
+								    ;; "run-path:
+								    ;; "
+								    ;; run-path)
+		  (iup:attribute-set! txtbox "VALUE"
+				      (string-intersperse (cdr run-path) "/"))
+		  #;(dashboard:update-run-command tabdat)
+                  #;(dboard:tabdat-layout-update-ok-set! tabdat #f)
+                  (if (number? run-id)
+                      (begin
+                        ;; capture last two in tabdat.
+                        (dboard:rdat-push-run-id rdat run-id)
+			(dboard:rdat-view-changed-set! rdat #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:rdat-runs-tree-set! rdat tb)
+    (iup:detachbox
+     (iup:vbox 
+      txtbox
+      tb
+      ))))
+

Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -24,11 +24,11 @@
 (import (prefix iup iup:))
 
 (use canvas-draw)
 (import canvas-draw-iup)
 (use ducttape-lib)
-(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors) ;; defstruct
+(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors matchable) ;; defstruct
 (import (prefix sqlite3 sqlite3:))
 
 (declare (uses common))
 (declare (uses margs))
 (declare (uses keys))
@@ -53,10 +53,12 @@
 (include "run_records.scm")
 (include "task_records.scm")
 (include "megatest-version.scm")
 (include "megatest-fossil-hash.scm")
 (include "vg_records.scm")
+;; This is the new runs view
+(include "dashboard-new-runs-view.scm")
 
 (define help (conc 
 	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
   version " megatest-version "
   license GPL, Copyright (C) Matt Welland 2012-2017
@@ -478,10 +480,13 @@
   (prev-run-ids  '())            ;; push previously looked at runs on this
   (view-changed #f)
 
   ;; widgets
   (runs-tree #f)                 ;; 
+  (runs-mtx  #f)                 ;; runs displayed here
+  (items-mtx #f)                 ;; items displayed here
+
   )
 
 (define (dboard:rdat-push-run-id rdat run-id)
   (dboard:rdat-prev-run-ids-set! rdat (cons run-id (dboard:rdat-prev-run-ids rdat))))
 
@@ -2739,10 +2744,11 @@
 	 (runs-dat        (dboard:tabdat-make-data))
 	 (runs2-dat       (make-dboard:rdat)) ;; (dboard:tabdat-make-data))
 	 (onerun-dat      (dboard:tabdat-make-data)) ;; name for run-summary structure 
 	 (runcontrols-dat (dboard:tabdat-make-data))
 	 (runtimes-dat    (dboard:tabdat-make-data))
+	 (runs-browse-dat (dboard:tabdat-make-data))
 	 (nruns           (dboard:tabdat-numruns runs-dat))
 	 (ntests          (dboard:tabdat-num-tests runs-dat))
 	 (keynames        (dboard:tabdat-dbkeys runs-dat))
 	 (nkeys           (length keynames))
 	 (runsvec         (make-vector nruns))
@@ -2963,10 +2969,11 @@
 			 (let ((order-a (or (any->number (configf:lookup views-cfgdat a "order")) 999))
 			       (order-b (or (any->number (configf:lookup views-cfgdat b "order")) 999)))
 			   (> order-a order-b)))))
 		result))
 	     (tabs (apply iup:tabs
+			  #:shrink "YES"
 			  #:tabchangepos-cb (lambda (obj curr prev)
 					      (debug:catch-and-dump
 					       (lambda ()
 						 (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
 							(tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
@@ -2981,10 +2988,11 @@
 			  runs-view
 			  ;; (make-runs-view commondat runs2-dat 2)
 			  (dashboard:runs-summary commondat onerun-dat tab-num: 2)
 			  (dashboard:run-controls commondat runcontrols-dat tab-num: 3)
 			  (dashboard:run-times commondat runtimes-dat tab-num: 4)
+			  (dashboard:runs-browse  commondat runs-browse-dat tab-num: 5)
 			  additional-views)))
 	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
 	(iup:attribute-set! tabs "TABTITLE0" "Summary")
 	(iup:attribute-set! tabs "TABTITLE1" "Runs")
 	;; (iup:attribute-set! tabs "TABTITLE2" "Runs2")
@@ -2991,10 +2999,11 @@
 	(iup:attribute-set! tabs "TABTITLE2" "Run Summary")
 	(iup:attribute-set! tabs "TABTITLE3" "Run Control")
 	(iup:attribute-set! tabs "TABTITLE4" "Run Times")
 	;; (iup:attribute-set! tabs "TABTITLE3" "New View")
 	;; (iup:attribute-set! tabs "TABTITLE4" "Run Control")
+	(iup:attribute-set! tabs "TABTITLE5" "Runs Browse")
 
 	;; set the tab names for user added tabs
 	(for-each
 	 (lambda (tab-info)
 	   (iup:attribute-set! tabs (conc "TABTITLE" (car tab-info)) (cdr tab-info)))
@@ -3008,10 +3017,11 @@
 	(dboard:common-set-tabdat! commondat 1 runs-dat)
 	;;(dboard:common-set-tabdat! commondat 2 runs2-dat)
 	(dboard:common-set-tabdat! commondat 2 onerun-dat)
 	(dboard:common-set-tabdat! commondat 3 runcontrols-dat)
 	(dboard:common-set-tabdat! commondat 4 runtimes-dat)
+	(dboard:common-set-tabdat! commondat 5 runs-browse-dat)
 
 	(iup:vbox
 	 tabs
 	 ;; controls
 	 ))))