Megatest

Diff
Login

Differences From Artifact [77b498cbd6]:

To Artifact [ec1185cec5]:


97
98
99
100
101
102
103
104
105
106

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

;; data common to all tabs goes here
;;
(defstruct dboard:commondat
  curr-tab-num
  please-update  
  tabdats

  update-mutex
  updaters 
  updating
  uidat ;; needs to move to tabdat at some time
  hide-not-hide-tabs
  )

(define (dboard:commondat-make)
  (make-dboard:commondat
   curr-tab-num:         0
   tabdats:              (make-hash-table)
   please-update:        #t
   update-mutex:         (make-mutex)
   updaters:             (make-hash-table)
   updating:             #f
   hide-not-hide-tabs:   #f
   ))

(define (dboard:common-get-tabdat commondat #!key (tab-num #f))
  (hash-table-ref/default 
   (dboard:commondat-tabdats commondat)
   (or tab-num (dboard:commondat-curr-tab-num commondat))
   #f))








|
<
|
>
|
|
|

|

<
<
<
<
<
<
<
<
<
<
<







97
98
99
100
101
102
103
104

105
106
107
108
109
110
111
112











113
114
115
116
117
118
119
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

;; data common to all tabs goes here
;;
(defstruct dboard:commondat
  ((curr-tab-num   0)                 : number)

  ((tabdats        (make-hash-table)) : hash-table)
  ;; ((update-mutex   (make-mutex))      : mutex)
  (update-mutex   (make-mutex))
  ((updaters       (make-hash-table)) : hash-table)
  ((updating       #f)                : boolean)
  uidat ;; needs to move to tabdat at some time
  ((hide-not-hide-tabs #f)            : boolean)
  )












(define (dboard:common-get-tabdat commondat #!key (tab-num #f))
  (hash-table-ref/default 
   (dboard:commondat-tabdats commondat)
   (or tab-num (dboard:commondat-curr-tab-num commondat))
   #f))

169
170
171
172
173
174
175

176
177
178
179
180
181
182
  (header            #f)                                ;; header for decoding the run records
  (keys              #f)                                ;; keys for this run (i.e. target components)
  ((numruns          (string->number (or (args:get-arg "-cols") "8")))                 : number)      ;; 
  ((tot-runs          0)                 : number)
  ((last-data-update  0)                 : number)      ;; last time the data in allruns was updated
  (runs-mutex         (make-mutex))                     ;; use to prevent parallel access to draw objects
  ((run-update-times  (make-hash-table)) : hash-table)  ;; update times indexed by run-id

  (last-test-dat      #f)                               ;; cache last tests dat
  ((run-db-paths      (make-hash-table)) : hash-table)  ;; cache the paths to the run db files

  ;; Runs view
  ((buttondat         (make-hash-table)) : hash-table)  ;;     
  ((item-test-names  '())                : list)        ;; list of itemized tests
  ((run-keys          (make-hash-table)) : hash-table)







>







158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
  (header            #f)                                ;; header for decoding the run records
  (keys              #f)                                ;; keys for this run (i.e. target components)
  ((numruns          (string->number (or (args:get-arg "-cols") "8")))                 : number)      ;; 
  ((tot-runs          0)                 : number)
  ((last-data-update  0)                 : number)      ;; last time the data in allruns was updated
  (runs-mutex         (make-mutex))                     ;; use to prevent parallel access to draw objects
  ((run-update-times  (make-hash-table)) : hash-table)  ;; update times indexed by run-id
  ((please-update     #t)                : boolean)     ;; was in commondat.
  (last-test-dat      #f)                               ;; cache last tests dat
  ((run-db-paths      (make-hash-table)) : hash-table)  ;; cache the paths to the run db files

  ;; Runs view
  ((buttondat         (make-hash-table)) : hash-table)  ;;     
  ((item-test-names  '())                : list)        ;; list of itemized tests
  ((run-keys          (make-hash-table)) : hash-table)
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
;; This is roughly the same as dboard:get-tests-dat, should merge them if possible
;;
;; gets all the tests for run-id that match testnamepatt and key-vals, merges them
;;
;;    NOTE: Yes, this is used
;;
(define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)
  (let* ((num-to-get  20)
	 (states      (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)))
	 (statuses    (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)))
	 (sort-info   (get-curr-sort))
	 (sort-by     (vector-ref sort-info 1))
	 (sort-order  (vector-ref sort-info 2))
	 (bubble-type (if (member sort-order '(testname))
			  'testname







|







458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
;; This is roughly the same as dboard:get-tests-dat, should merge them if possible
;;
;; gets all the tests for run-id that match testnamepatt and key-vals, merges them
;;
;;    NOTE: Yes, this is used
;;
(define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)
  (let* ((num-to-get  100)
	 (states      (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)))
	 (statuses    (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)))
	 (sort-info   (get-curr-sort))
	 (sort-by     (vector-ref sort-info 1))
	 (sort-order  (vector-ref sort-info 2))
	 (bubble-type (if (member sort-order '(testname))
			  'testname
915
916
917
918
919
920
921
922

923
924


925
926
927
928
929
930
931
    (dboard:tabdat-filters-changed-set! tabdat #t)))

(define (update-search commondat tabdat x val)
  (hash-table-set! (dboard:tabdat-searchpatts tabdat) x val)
  (dboard:tabdat-filters-changed-set! tabdat #t)
  (set-bg-on-filter commondat tabdat))

(define (mark-for-update tabdat)

  (dboard:tabdat-filters-changed-set! tabdat #t)
  (dboard:tabdat-last-db-update-set! tabdat 0))



;;======================================================================
;; R U N C O N T R O L
;;======================================================================

;; target populating logic
;;  







|
>

|
>
>







905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
    (dboard:tabdat-filters-changed-set! tabdat #t)))

(define (update-search commondat tabdat x val)
  (hash-table-set! (dboard:tabdat-searchpatts tabdat) x val)
  (dboard:tabdat-filters-changed-set! tabdat #t)
  (set-bg-on-filter commondat tabdat))

(define (mark-for-update update-mutex tabdat)
  (mutex-lock! update-mutex)
  (dboard:tabdat-filters-changed-set! tabdat #t)
  (dboard:tabdat-last-db-update-set! tabdat 0)
  (dboard:tabdat-please-update-set! tabdat #t)
  (mutex-unlock! update-mutex))

;;======================================================================
;; R U N C O N T R O L
;;======================================================================

;; target populating logic
;;  
1213
1214
1215
1216
1217
1218
1219

1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234

1235
1236
1237
1238
1239
1240
1241
 ;; #: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-browser commondat tabdat)

  (let* ((tb      (iup:treebox
		   #:value 0
		   #:name "Runs"
		   #:expand "YES"
		   #:addexpanded "NO"
		   #:selection-cb
		   (lambda (obj id state)
		     (debug:catch-and-dump
		      (lambda ()
			(let* ((run-path (tree:node->path obj id))
			       (run-id    (tree-path->run-id tabdat (cdr run-path))))
			  (dboard:tabdat-target-set! tabdat (cdr run-path)) ;; (print "run-path: " run-path)			    
			  (dboard:tabdat-layout-update-ok-set! tabdat #f)
			  (if (number? run-id)
			      (begin

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







>
|










|



>







1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
 ;; #: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-browser commondat tabdat)
  (let* ((update-mutex (dboard:commondat-update-mutex commondat))
	 (tb      (iup:treebox
		   #:value 0
		   #:name "Runs"
		   #:expand "YES"
		   #:addexpanded "NO"
		   #:selection-cb
		   (lambda (obj id state)
		     (debug:catch-and-dump
		      (lambda ()
			(let* ((run-path (tree:node->path obj id))
			       (run-id    (tree-path->run-id tabdat (cdr run-path))))
			  (dboard:tabdat-target-set! tabdat (cdr run-path))
			  (dboard:tabdat-layout-update-ok-set! tabdat #f)
			  (if (number? run-id)
			      (begin
				(mark-for-update update-mutex tabdat)
				(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)
1381
1382
1383
1384
1385
1386
1387


1388
1389
1390
1391
1392
1393
1394

(define (dashboard:safe-cadr-assoc name lst)
  (let ((res (assoc name lst)))
    (if (and res (> (length res) 1))
	(cadr res)
	#f)))



(define (dboard:update-tree tabdat runs-hash runs-header tb)
  (let* ((run-ids (sort (filter number? (hash-table-keys runs-hash))
			(lambda (a b)
			  (let* ((record-a (hash-table-ref runs-hash a))
				 (record-b (hash-table-ref runs-hash b))
				 (time-a   (db:get-value-by-header record-a runs-header "event_time"))
				 (time-b   (db:get-value-by-header record-b runs-header "event_time")))







>
>







1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391

(define (dashboard:safe-cadr-assoc name lst)
  (let ((res (assoc name lst)))
    (if (and res (> (length res) 1))
	(cadr res)
	#f)))

;; generic update of tree with targets, runs
;;
(define (dboard:update-tree tabdat runs-hash runs-header tb)
  (let* ((run-ids (sort (filter number? (hash-table-keys runs-hash))
			(lambda (a b)
			  (let* ((record-a (hash-table-ref runs-hash a))
				 (record-b (hash-table-ref runs-hash b))
				 (time-a   (db:get-value-by-header record-a runs-header "event_time"))
				 (time-b   (db:get-value-by-header record-b runs-header "event_time")))
1412
1413
1414
1415
1416
1417
1418
1419


1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431

1432
1433
1434
1435
1436
1437
1438
			;; Here we update the tests treebox and tree keys
			(tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
				       userdata: (conc "run-id: " run-id))
			(hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
			;; (set! colnum (+ colnum 1))
			))))
	      run-ids)))
  


(define (dashboard:one-run-updater commondat tabdat tb cell-lookup run-matrix)
  (let* ((runs-dat     (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f))
	 (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
	 (run-id       (dboard:tabdat-curr-run-id tabdat))
	 (last-update  (hash-table-ref/default (dboard:tabdat-run-update-times tabdat) run-id 0))
	 (db-path      (or (hash-table-ref/default (dboard:tabdat-run-db-paths tabdat) run-id #f)
			   (let* ((db-dir (tasks:get-task-db-path))
				  (db-pth (conc db-dir "/" run-id ".db")))
			     (hash-table-set! (dboard:tabdat-run-db-paths tabdat) run-id db-pth)
			     db-pth)))
	 (tests-dat    (if (or (not run-id)
			       (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")

			       (>= (file-modification-time db-path) last-update))
			   (dboard:get-tests-dat tabdat run-id last-update)
			   (dboard:tabdat-last-test-dat  tabdat)))
	 (tests-mindat (dcommon:minimize-test-data tests-dat))
	 (indices      (common:sparse-list-generate-index tests-mindat)) ;;  proc: set-cell))
	 (row-indices  (cadr indices))
	 (col-indices  (car indices))







|
>
>












>







1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
			;; Here we update the tests treebox and tree keys
			(tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
				       userdata: (conc "run-id: " run-id))
			(hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id)
			;; (set! colnum (+ colnum 1))
			))))
	      run-ids)))

;; Updater for the run summary view
;;
(define (dashboard:one-run-updater commondat tabdat tb cell-lookup run-matrix)
  (let* ((runs-dat     (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f))
	 (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
	 (run-id       (dboard:tabdat-curr-run-id tabdat))
	 (last-update  (hash-table-ref/default (dboard:tabdat-run-update-times tabdat) run-id 0))
	 (db-path      (or (hash-table-ref/default (dboard:tabdat-run-db-paths tabdat) run-id #f)
			   (let* ((db-dir (tasks:get-task-db-path))
				  (db-pth (conc db-dir "/" run-id ".db")))
			     (hash-table-set! (dboard:tabdat-run-db-paths tabdat) run-id db-pth)
			     db-pth)))
	 (tests-dat    (if (or (not run-id)
			       (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")
			       (dboard:tabdat-please-update tabdat)
			       (>= (file-modification-time db-path) last-update))
			   (dboard:get-tests-dat tabdat run-id last-update)
			   (dboard:tabdat-last-test-dat  tabdat)))
	 (tests-mindat (dcommon:minimize-test-data tests-dat))
	 (indices      (common:sparse-list-generate-index tests-mindat)) ;;  proc: set-cell))
	 (row-indices  (cadr indices))
	 (col-indices  (car indices))
1563
1564
1565
1566
1567
1568
1569

1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583

1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619

1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
;;======================================================================
;;
;; display and manage a single run at a time

;; This is the Run Summary tab
;; 
(define (dashboard:one-run commondat tabdat #!key (tab-num #f))

  (let* ((tb      (iup:treebox
		   #:value 0
		   #:name "Runs"
		   #:expand "YES"
		   #:addexpanded "NO"
		   #:selection-cb
		   (lambda (obj id state)
		     (debug:catch-and-dump
		      (lambda ()
			;; (print "obj: " obj ", id: " id ", state: " state)
			(let* ((run-path (tree:node->path obj id))
			       (run-id   (tree-path->run-id tabdat (cdr run-path))))
			  (if (number? run-id)
			      (begin

				(dboard:tabdat-curr-run-id-set! tabdat run-id)
				(dboard:tabdat-layout-update-ok-set! tabdat #f)
				;; (dashboard:update-run-summary-tab)
				)
			      ;; (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id)
			      )))
		      "selection-cb in one-run")
		     ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
		     )))
	 (cell-lookup (make-hash-table))
	 (run-matrix (iup:matrix
		      #:expand "YES"
		      #:click-cb
		      (lambda (obj lin col status)
			(let* ((toolpath (car (argv)))
			       (key      (conc lin ":" col))
			       (test-id  (hash-table-ref/default cell-lookup key -1))
			       (cmd      (conc toolpath " -test " (dboard:tabdat-curr-run-id tabdat) "," test-id "&")))
			  (system cmd)))))
	 (one-run-updater  (lambda ()
			     (if  (dashboard:database-changed? commondat tabdat)
				  (dashboard:one-run-updater commondat tabdat tb cell-lookup run-matrix)))))
    (dboard:commondat-add-updater commondat one-run-updater tab-num: tab-num)
    (dboard:tabdat-runs-tree-set! tabdat tb)
    (iup:vbox
     (iup:split
      tb
      run-matrix)
     (dboard:make-controls commondat tabdat))))

;;======================================================================
;; R U N S 
;;======================================================================

(define (dboard:make-controls commondat tabdat)
  (let ((btn-fontsz  (dboard:tabdat-runs-btn-fontsz tabdat)))

    (iup:hbox
     (iup:vbox
      (iup:frame 
       #:title "filter test and items"
       (iup:hbox
	(iup:vbox
	 (iup:textbox #:size "120x15" #:fontsize "10" #:value "%"
		      #:expand "NO"
		      #:action (lambda (obj unk val)
				 (debug:catch-and-dump
				  (lambda ()
				    (mark-for-update tabdat)
				    (update-search commondat tabdat "test-name" val))
				  "make-controls")))
	 (iup:hbox
	  (iup:button "Quit"      #:action (lambda (obj)
					     ;; (if (dboard:tabdat-dblocal tabdat) (db:close-all (dboard:tabdat-dblocal tabdat)))
					     (exit))
		      #:expand "NO" #:size "40x15")
	  (iup:button "Refresh"   #:action (lambda (obj)
					     (mark-for-update tabdat))
		      #:expand "NO" #:size "40x15")
	  (iup:button "Collapse"  #:action (lambda (obj)
					     (debug:catch-and-dump 
					      (lambda ()
						(let ((myname (iup:attribute obj "TITLE")))
						  (if (equal? myname "Collapse")
						      (begin
							(for-each (lambda (tname)
								    (hash-table-set! *collapsed* tname #t))
								  (dboard:tabdat-item-test-names tabdat))
							(iup:attribute-set! obj "TITLE" "Expand"))
						      (begin
							(for-each (lambda (tname)
								    (hash-table-delete! *collapsed* tname))
								  (hash-table-keys *collapsed*))
							(iup:attribute-set! obj "TITLE" "Collapse"))))
						(mark-for-update tabdat))
					      "make-controls collapse button"))
		      #:expand "NO" #:size "40x15")))
	(iup:vbox
	 ;; (iup:button "Sort -t"   #:action (lambda (obj)
	 ;;   				 (next-sort-option)
	 ;;   				 (iup:attribute-set! obj "TITLE" (vector-ref (vector-ref *tests-sort-options* *tests-sort-reverse*) 0))
	 ;;   				 (mark-for-update tabdat)))
	 
	 (let* ((hide #f)
		(show #f)
		(hide-empty #f)
		(sel-color    "180 100 100")
		(nonsel-color "170 170 170")
		(cmds-list '("+testname" "-testname" "+event_time" "-event_time" "+statestatus" "-statestatus"))
		(sort-lb    (iup:listbox #:expand "NO" ;; "HORIZONTAL"
					 #:size   "80x15"
					 #:dropdown "YES"
					 #:action (lambda (obj val index lbstate)
						    (set! *tests-sort-reverse* index)
						    (mark-for-update tabdat))))
		(default-cmd (car (list-ref *tests-sort-type-index* *tests-sort-reverse*))))
	   (iuplistbox-fill-list sort-lb cmds-list selected-item: default-cmd)
	   
	   (set! hide-empty (iup:button "HideEmpty"
					;; #:expand HORIZONTAL"
					#:expand "NO" #:size "80x15"
					#:action (lambda (obj)
						   (dboard:tabdat-hide-empty-runs-set! tabdat (not (dboard:tabdat-hide-empty-runs tabdat)))
						   (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 "BGCOLOR" sel-color)
					     (iup:attribute-set! show "BGCOLOR" 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 "BGCOLOR" sel-color)
					     (iup:attribute-set! hide "BGCOLOR" nonsel-color)
					     (mark-for-update tabdat))))
	   (iup:attribute-set! hide "BGCOLOR" sel-color)
	   (iup:attribute-set! show "BGCOLOR" nonsel-color)
	   ;; (dboard:tabdat-hide-not-hide-button-set! tabdat hideit) ;; never used, can eliminate ...
	   (iup:vbox
	    (iup:hbox hide show)
	    hide-empty sort-lb)))
	)))
     (iup:frame 
      #:title "state/status filter"
      (iup:vbox
       (apply 
	iup:hbox
	(map (lambda (status)
	       (iup:toggle (conc status "  ")
			   #:fontsize btn-fontsz ;; "10"
			   #:expand "HORIZONTAL"
			   #:action   (lambda (obj val)
					(mark-for-update tabdat)
					(if (eq? val 1)
					    (hash-table-set! (dboard:tabdat-status-ignore-hash tabdat) status #t)
					    (hash-table-delete! (dboard:tabdat-status-ignore-hash tabdat) status))
					(set-bg-on-filter commondat tabdat))))
	     (map cadr *common:std-statuses*))) ;; '("PASS" "FAIL" "WARN" "CHECK" "WAIVED" "STUCK/DEAD" "n/a" "SKIP")))
       (apply 
	iup:hbox
	(map (lambda (state)
	       (iup:toggle (conc state "  ")
			   #:fontsize btn-fontsz
			   #:expand "HORIZONTAL"
			   #:action   (lambda (obj val)
					(mark-for-update tabdat)
					(if (eq? val 1)
					    (hash-table-set! (dboard:tabdat-state-ignore-hash tabdat) state #t)
					    (hash-table-delete! (dboard:tabdat-state-ignore-hash tabdat) state))
					(set-bg-on-filter commondat tabdat))))
	     (map cadr *common:std-states*))) ;; '("RUNNING" "COMPLETED" "INCOMPLETE" "LAUNCHED" "NOT_STARTED" "KILLED" "DELETED")))
       (iup:valuator #:valuechanged_cb (lambda (obj)
					 (let ((val (inexact->exact (round (/ (string->number (iup:attribute obj "VALUE")) 10))))
					       (oldmax   (string->number (iup:attribute obj "MAX")))
					       (maxruns  (dboard:tabdat-tot-runs tabdat)))
					   (dboard:tabdat-start-run-offset-set! tabdat val)
					   (mark-for-update tabdat)
					   (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
					   (iup:attribute-set! obj "MAX" (* maxruns 10))))
		     #:expand "HORIZONTAL"
		     #:max (* 10 (length (dboard:tabdat-allruns tabdat)))
		     #:min 0
		     #:step 0.01)))
					;(iup:button "inc rows" #:action (lambda (obj)(dboard:tabdat-num-tests-set! tabdat (+ (dboard:tabdat-num-tests tabdat) 1))))







>
|













>




















|
|













|
>











|








|
















|



















|









|







|






|

















|












|










|







1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
;;======================================================================
;;
;; display and manage a single run at a time

;; This is the Run Summary tab
;; 
(define (dashboard:one-run commondat tabdat #!key (tab-num #f))
  (let* ((update-mutex (dboard:commondat-update-mutex commondat))
	 (tb      (iup:treebox
		   #:value 0
		   #:name "Runs"
		   #:expand "YES"
		   #:addexpanded "NO"
		   #:selection-cb
		   (lambda (obj id state)
		     (debug:catch-and-dump
		      (lambda ()
			;; (print "obj: " obj ", id: " id ", state: " state)
			(let* ((run-path (tree:node->path obj id))
			       (run-id   (tree-path->run-id tabdat (cdr run-path))))
			  (if (number? run-id)
			      (begin
				(mark-for-update update-mutex tabdat)
				(dboard:tabdat-curr-run-id-set! tabdat run-id)
				(dboard:tabdat-layout-update-ok-set! tabdat #f)
				;; (dashboard:update-run-summary-tab)
				)
			      ;; (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id)
			      )))
		      "selection-cb in one-run")
		     ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
		     )))
	 (cell-lookup (make-hash-table))
	 (run-matrix (iup:matrix
		      #:expand "YES"
		      #:click-cb
		      (lambda (obj lin col status)
			(let* ((toolpath (car (argv)))
			       (key      (conc lin ":" col))
			       (test-id  (hash-table-ref/default cell-lookup key -1))
			       (cmd      (conc toolpath " -test " (dboard:tabdat-curr-run-id tabdat) "," test-id "&")))
			  (system cmd)))))
	 (one-run-updater  (lambda ()
			     ;; (if  (dashboard:database-changed? commondat tabdat)
			     (dashboard:one-run-updater commondat tabdat tb cell-lookup run-matrix))));; )
    (dboard:commondat-add-updater commondat one-run-updater tab-num: tab-num)
    (dboard:tabdat-runs-tree-set! tabdat tb)
    (iup:vbox
     (iup:split
      tb
      run-matrix)
     (dboard:make-controls commondat tabdat))))

;;======================================================================
;; R U N S 
;;======================================================================

(define (dboard:make-controls commondat tabdat)
  (let ((btn-fontsz  (dboard:tabdat-runs-btn-fontsz tabdat))
	(update-mutex (dboard:commondat-update-mutex commondat)))
    (iup:hbox
     (iup:vbox
      (iup:frame 
       #:title "filter test and items"
       (iup:hbox
	(iup:vbox
	 (iup:textbox #:size "120x15" #:fontsize "10" #:value "%"
		      #:expand "NO"
		      #:action (lambda (obj unk val)
				 (debug:catch-and-dump
				  (lambda ()
				    (mark-for-update update-mutex tabdat)
				    (update-search commondat tabdat "test-name" val))
				  "make-controls")))
	 (iup:hbox
	  (iup:button "Quit"      #:action (lambda (obj)
					     ;; (if (dboard:tabdat-dblocal tabdat) (db:close-all (dboard:tabdat-dblocal tabdat)))
					     (exit))
		      #:expand "NO" #:size "40x15")
	  (iup:button "Refresh"   #:action (lambda (obj)
					     (mark-for-update update-mutex tabdat))
		      #:expand "NO" #:size "40x15")
	  (iup:button "Collapse"  #:action (lambda (obj)
					     (debug:catch-and-dump 
					      (lambda ()
						(let ((myname (iup:attribute obj "TITLE")))
						  (if (equal? myname "Collapse")
						      (begin
							(for-each (lambda (tname)
								    (hash-table-set! *collapsed* tname #t))
								  (dboard:tabdat-item-test-names tabdat))
							(iup:attribute-set! obj "TITLE" "Expand"))
						      (begin
							(for-each (lambda (tname)
								    (hash-table-delete! *collapsed* tname))
								  (hash-table-keys *collapsed*))
							(iup:attribute-set! obj "TITLE" "Collapse"))))
						(mark-for-update update-mutex tabdat))
					      "make-controls collapse button"))
		      #:expand "NO" #:size "40x15")))
	(iup:vbox
	 ;; (iup:button "Sort -t"   #:action (lambda (obj)
	 ;;   				 (next-sort-option)
	 ;;   				 (iup:attribute-set! obj "TITLE" (vector-ref (vector-ref *tests-sort-options* *tests-sort-reverse*) 0))
	 ;;   				 (mark-for-update tabdat)))
	 
	 (let* ((hide #f)
		(show #f)
		(hide-empty #f)
		(sel-color    "180 100 100")
		(nonsel-color "170 170 170")
		(cmds-list '("+testname" "-testname" "+event_time" "-event_time" "+statestatus" "-statestatus"))
		(sort-lb    (iup:listbox #:expand "NO" ;; "HORIZONTAL"
					 #:size   "80x15"
					 #:dropdown "YES"
					 #:action (lambda (obj val index lbstate)
						    (set! *tests-sort-reverse* index)
						    (mark-for-update update-mutex tabdat))))
		(default-cmd (car (list-ref *tests-sort-type-index* *tests-sort-reverse*))))
	   (iuplistbox-fill-list sort-lb cmds-list selected-item: default-cmd)
	   
	   (set! hide-empty (iup:button "HideEmpty"
					;; #:expand HORIZONTAL"
					#:expand "NO" #:size "80x15"
					#:action (lambda (obj)
						   (dboard:tabdat-hide-empty-runs-set! tabdat (not (dboard:tabdat-hide-empty-runs tabdat)))
						   (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-empty-runs tabdat) "+HideE" "-HideE"))
						   (mark-for-update update-mutex 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 "BGCOLOR" sel-color)
					     (iup:attribute-set! show "BGCOLOR" nonsel-color)
					     (mark-for-update update-mutex 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 "BGCOLOR" sel-color)
					     (iup:attribute-set! hide "BGCOLOR" nonsel-color)
					     (mark-for-update update-mutex tabdat))))
	   (iup:attribute-set! hide "BGCOLOR" sel-color)
	   (iup:attribute-set! show "BGCOLOR" nonsel-color)
	   ;; (dboard:tabdat-hide-not-hide-button-set! tabdat hideit) ;; never used, can eliminate ...
	   (iup:vbox
	    (iup:hbox hide show)
	    hide-empty sort-lb)))
	)))
     (iup:frame 
      #:title "state/status filter"
      (iup:vbox
       (apply 
	iup:hbox
	(map (lambda (status)
	       (iup:toggle (conc status "  ")
			   #:fontsize btn-fontsz ;; "10"
			   #:expand "HORIZONTAL"
			   #:action   (lambda (obj val)
					(mark-for-update update-mutex tabdat)
					(if (eq? val 1)
					    (hash-table-set! (dboard:tabdat-status-ignore-hash tabdat) status #t)
					    (hash-table-delete! (dboard:tabdat-status-ignore-hash tabdat) status))
					(set-bg-on-filter commondat tabdat))))
	     (map cadr *common:std-statuses*))) ;; '("PASS" "FAIL" "WARN" "CHECK" "WAIVED" "STUCK/DEAD" "n/a" "SKIP")))
       (apply 
	iup:hbox
	(map (lambda (state)
	       (iup:toggle (conc state "  ")
			   #:fontsize btn-fontsz
			   #:expand "HORIZONTAL"
			   #:action   (lambda (obj val)
					(mark-for-update update-mutex tabdat)
					(if (eq? val 1)
					    (hash-table-set! (dboard:tabdat-state-ignore-hash tabdat) state #t)
					    (hash-table-delete! (dboard:tabdat-state-ignore-hash tabdat) state))
					(set-bg-on-filter commondat tabdat))))
	     (map cadr *common:std-states*))) ;; '("RUNNING" "COMPLETED" "INCOMPLETE" "LAUNCHED" "NOT_STARTED" "KILLED" "DELETED")))
       (iup:valuator #:valuechanged_cb (lambda (obj)
					 (let ((val (inexact->exact (round (/ (string->number (iup:attribute obj "VALUE")) 10))))
					       (oldmax   (string->number (iup:attribute obj "MAX")))
					       (maxruns  (dboard:tabdat-tot-runs tabdat)))
					   (dboard:tabdat-start-run-offset-set! tabdat val)
					   (mark-for-update update-mutex tabdat)
					   (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
					   (iup:attribute-set! obj "MAX" (* maxruns 10))))
		     #:expand "HORIZONTAL"
		     #:max (* 10 (length (dboard:tabdat-allruns tabdat)))
		     #:min 0
		     #:step 0.01)))
					;(iup:button "inc rows" #:action (lambda (obj)(dboard:tabdat-num-tests-set! tabdat (+ (dboard:tabdat-num-tests tabdat) 1))))
1858
1859
1860
1861
1862
1863
1864
1865

1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
	 (lftlst          '())
	 (hdrlst          '())
	 (bdylst          '())
	 (result          '())
	 (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))
    
    ;; 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 "%" #:expand "NO" ;; "HORIZONTAL"
									#:action (lambda (obj unk val)
										   (mark-for-update runs-dat)
										   (update-search commondat runs-dat x val))))))
					(set! i (+ i 1))
					res))
				    keynames)))))
    (let loop ((testnum  0)
	       (res      '()))
      (cond
       ((>= testnum ntests)
	;; now lftlst will be an hbox with the test keys and the test name labels
	(set! lftlst (append lftlst (list (iup:hbox  #:expand "HORIZONTAL"
						     (iup:valuator #:valuechanged_cb (lambda (obj)
										       (let ((val (string->number (iup:attribute obj "VALUE")))
											     (oldmax  (string->number (iup:attribute obj "MAX")))
											     (newmax  (* 10 (length (dboard:tabdat-all-test-names runs-dat)))))
											 (dboard:commondat-please-update-set! commondat #t)
											 (dboard:tabdat-start-test-offset-set! runs-dat (inexact->exact (round (/ val 10))))
											 (debug:print 6 *default-log-port* "(dboard:tabdat-start-test-offset runs-dat) " (dboard:tabdat-start-test-offset runs-dat) " val: " val " newmax: " newmax " oldmax: " oldmax)
											 (if (< val 10)
											     (iup:attribute-set! obj "MAX" newmax))
											 ))
								   #:expand "VERTICAL" 
								   #:orientation "VERTICAL"
								   #:min 0
								   #:step 0.01)
						     (apply iup:vbox (reverse res)))))))
       (else
	(let ((labl  (iup:button "" ;; the testname labels
				 #:flat "YES" 
				 #:alignment "ALEFT"
					; #:image img1
					; #:impress img2
				 #:size  (conc cell-width btn-height)
				 #:expand  "HORIZONTAL"
				 #:fontsize btn-fontsz
				 #:action (lambda (obj)
					    (mark-for-update runs-dat)
					    (toggle-hide testnum (dboard:commondat-uidat commondat)))))) ;; (iup:attribute obj "TITLE"))))
	  (vector-set! lftcol testnum labl)
	  (loop (+ testnum 1)(cons labl res))))))
    ;; These are the headers for each row
    (let loop ((runnum  0)
	       (keynum  0)
	       (keyvec  (make-vector nkeys))







|
>












|














|




















|







1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
	 (lftlst          '())
	 (hdrlst          '())
	 (bdylst          '())
	 (result          '())
	 (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))
	 (update-mutex    (dboard:commondat-update-mutex commondat)))
    ;; controls (along bottom)
    ;; (set! controls (dboard:make-controls commondat runs-dat))
    
    ;; 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 "%" #:expand "NO" ;; "HORIZONTAL"
									#:action (lambda (obj unk val)
										   (mark-for-update update-mutex runs-dat)
										   (update-search commondat runs-dat x val))))))
					(set! i (+ i 1))
					res))
				    keynames)))))
    (let loop ((testnum  0)
	       (res      '()))
      (cond
       ((>= testnum ntests)
	;; now lftlst will be an hbox with the test keys and the test name labels
	(set! lftlst (append lftlst (list (iup:hbox  #:expand "HORIZONTAL"
						     (iup:valuator #:valuechanged_cb (lambda (obj)
										       (let ((val (string->number (iup:attribute obj "VALUE")))
											     (oldmax  (string->number (iup:attribute obj "MAX")))
											     (newmax  (* 10 (length (dboard:tabdat-all-test-names runs-dat)))))
											  (mark-for-update update-mutex tabdat)
											 (dboard:tabdat-start-test-offset-set! runs-dat (inexact->exact (round (/ val 10))))
											 (debug:print 6 *default-log-port* "(dboard:tabdat-start-test-offset runs-dat) " (dboard:tabdat-start-test-offset runs-dat) " val: " val " newmax: " newmax " oldmax: " oldmax)
											 (if (< val 10)
											     (iup:attribute-set! obj "MAX" newmax))
											 ))
								   #:expand "VERTICAL" 
								   #:orientation "VERTICAL"
								   #:min 0
								   #:step 0.01)
						     (apply iup:vbox (reverse res)))))))
       (else
	(let ((labl  (iup:button "" ;; the testname labels
				 #:flat "YES" 
				 #:alignment "ALEFT"
					; #:image img1
					; #:impress img2
				 #:size  (conc cell-width btn-height)
				 #:expand  "HORIZONTAL"
				 #:fontsize btn-fontsz
				 #:action (lambda (obj)
					    (mark-for-update update-mutex runs-dat)
					    (toggle-hide testnum (dboard:commondat-uidat commondat)))))) ;; (iup:attribute obj "TITLE"))))
	  (vector-set! lftcol testnum labl)
	  (loop (+ testnum 1)(cons labl res))))))
    ;; These are the headers for each row
    (let loop ((runnum  0)
	       (keynum  0)
	       (keyvec  (make-vector nkeys))
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
					 (lambda ()
					   (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
						  (tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
					     (dboard:tabdat-layout-update-ok-set! tabdat #f))
					   (dboard:commondat-curr-tab-num-set! commondat curr)
					   (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
						  (tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
					     (dboard:commondat-please-update-set! commondat #t)
					     (dboard:tabdat-layout-update-ok-set! tabdat #t)))
					 "tabchangepos"))
		    (dashboard:summary commondat stats-dat tab-num: 0)
		    runs-view
		    (dashboard:one-run commondat onerun-dat tab-num: 2)
		    ;; (dashboard:new-view db data new-view-dat tab-num: 3)
		    (dashboard:run-controls commondat runcontrols-dat tab-num: 3)







|







2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
					 (lambda ()
					   (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
						  (tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
					     (dboard:tabdat-layout-update-ok-set! tabdat #f))
					   (dboard:commondat-curr-tab-num-set! commondat curr)
					   (let* ((tab-num (dboard:commondat-curr-tab-num commondat))
						  (tabdat  (dboard:common-get-tabdat commondat tab-num: tab-num)))
					     (mark-for-update update-mutex tabdat)
					     (dboard:tabdat-layout-update-ok-set! tabdat #t)))
					 "tabchangepos"))
		    (dashboard:summary commondat stats-dat tab-num: 0)
		    runs-view
		    (dashboard:one-run commondat onerun-dat tab-num: 2)
		    ;; (dashboard:new-view db data new-view-dat tab-num: 3)
		    (dashboard:run-controls commondat runcontrols-dat tab-num: 3)
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
	  (set! *last-monitor-update-time* run-update-time) ;; monitor-modtime)
	  #t)
	#f)))

(define (dashboard:database-changed? commondat tabdat)
  (let* ((run-update-time (current-seconds))
	 (modtime         (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!! 
	 (recalc          (dashboard:recalc modtime (dboard:commondat-please-update commondat) (dboard:tabdat-last-db-update tabdat))))
     (dboard:commondat-please-update-set! commondat #f)
     recalc))

;; point inside line
;;
(define-inline (dashboard:px-between px lx1 lx2)
  (and (< lx1 px)(> lx2 px)))








|
|







2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
	  (set! *last-monitor-update-time* run-update-time) ;; monitor-modtime)
	  #t)
	#f)))

(define (dashboard:database-changed? commondat tabdat)
  (let* ((run-update-time (current-seconds))
	 (modtime         (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!! 
	 (recalc          (dashboard:recalc modtime (dboard:tabdat-please-update tabdat) (dboard:tabdat-last-db-update tabdat))))
     (dboard:tabdat-please-update-set! tabdat #f)
     recalc))

;; point inside line
;;
(define-inline (dashboard:px-between px lx1 lx2)
  (and (< lx1 px)(> lx2 px)))

2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define (main)
  (if (not (args:get-arg "-skip-version-check"))(common:exit-on-version-changed))
  (let* ((commondat       (dboard:commondat-make)))
    ;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
    (cond 
     ((args:get-arg "-test") ;; run-id,test-id
      (let* ((dat     (let ((d (map string->number (string-split (args:get-arg "-test") ","))))
			(if (> (length d) 1)
			    d
			    (list #f #f))))







|







2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define (main)
  (if (not (args:get-arg "-skip-version-check"))(common:exit-on-version-changed))
  (let* ((commondat       (make-dboard:commondat)))
    ;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
    (cond 
     ((args:get-arg "-test") ;; run-id,test-id
      (let* ((dat     (let ((d (map string->number (string-split (args:get-arg "-test") ","))))
			(if (> (length d) 1)
			    d
			    (list #f #f))))