| ︙ | | |
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
|
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;;(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-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 0 *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)
tb))
;;======================================================================
;; R U N C O N T R O L S
;;======================================================================
;;
;; A gui for launching tests
;;
|
| ︙ | | |
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
|
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
|
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
+
|
(dboard:target-updater tabdat))))
(dboard:tabdat-drawing-set! tabdat drawing)
(dboard:commondat-add-updater commondat run-times-tab-updater tab-num: tab-num)
(iup:split
#:orientation "VERTICAL" ;; "HORIZONTAL"
#:value 150
(iup:vbox
(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 0 *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)
tb)
#:expand "YES"
#:expand "HORIZONTAL"
#:value 1
#:action (lambda (obj tstate)
(debug:catch-and-dump
(lambda ()
(print "tstate: " tstate)
(if (eq? tstate 0)
(dboard:tabdat-compact-layout-set! tabdat #f)
|
| ︙ | | |
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
|
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
|
-
+
-
+
-
+
|
#: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 "YES"
#:expand "HORIZONTAL"
#: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 "YES"
#: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 "YES"
#: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)
|
| ︙ | | |
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
|
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
|
-
+
+
+
-
-
+
+
|
(lftcol (make-vector ntests))
(keycol (make-vector ntests))
(controls '())
(lftlst '())
(hdrlst '())
(bdylst '())
(result '())
(i 0))
(i 0)
(btn-height (dboard:tabdat-runs-btn-height runs-dat))
(btn-fontsz (dboard:tabdat-runs-btn-fontsz 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 "x15" #:fontsize "10" #:expand "HORIZONTAL")
(iup:textbox #:size "x15" #:fontsize "10" #:value "%" #:expand "HORIZONTAL"
(iup:label x #:size (conc 30 btn-height) #:fontsize btn-fontsz #:expand "NO") ;; "HORIZONTAL")
(iup:textbox #:size (conc 20 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)
|
| ︙ | | |
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
|
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
|
-
-
-
+
+
+
-
+
-
+
-
+
-
+
|
(apply iup:vbox (reverse res)))))))
(else
(let ((labl (iup:button ""
#:flat "YES"
#:alignment "ALEFT"
; #:image img1
; #:impress img2
#:size (dboard:tabdat-runs-btn-height runs-dat) ;; "x15"
#:expand "HORIZONTAL"
#:fontsize (dboard:tabdat-runs-btn-fontsz runs-dat) ;; "10"
#:size btn-height
#:expand "NO" ;; "HORIZONTAL"
#:fontsize btn-fontsz
#:action (lambda (obj)
(mark-for-update tabdat)
(toggle-hide testnum uidat))))) ;; (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))
(res '()))
(cond ;; nb// no else for this approach.
((>= runnum nruns) #f)
((>= keynum nkeys)
(vector-set! header runnum keyvec)
(set! hdrlst (cons (apply iup:vbox (reverse res)) hdrlst))
(loop (+ runnum 1) 0 (make-vector nkeys) '()))
(else
(let ((labl (iup:label "" #:size "60x15" #:fontsize "10" #:expand "HORIZONTAL"))) ;; #:expand "HORIZONTAL"
(let ((labl (iup:label "" #:size btn-height #:fontsize btn-fontsz #:expand "HORIZONTAL"))) ;; #:expand "HORIZONTAL" "60x15"
(vector-set! keyvec keynum labl)
(loop runnum (+ keynum 1) keyvec (cons labl res))))))
;; By here the hdrlst contains a list of vboxes containing nkeys labels
(let loop ((runnum 0)
(testnum 0)
(testvec (make-vector ntests))
(res '()))
(cond
((>= runnum nruns) #f) ;; (vector tableheader runsvec))
((>= testnum ntests)
(vector-set! runsvec runnum testvec)
(set! bdylst (cons (apply iup:vbox (reverse res)) bdylst))
(loop (+ runnum 1) 0 (make-vector ntests) '()))
(else
(let* ((button-key (mkstr runnum testnum))
(butn (iup:button
"" ;; button-key
#:size (dboard:tabdat-runs-btn-height runs-dat) ;; "60x15"
#:size btn-height
#:expand "HORIZONTAL"
#:fontsize (dboard:tabdat-runs-btn-fontsz runs-dat) ;; "10"
#: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)))
(buttndat (hash-table-ref (dboard:tabdat-buttondat runs-dat) button-key))
|
| ︙ | | |
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
|
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
|
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
|
(loop runnum (+ testnum 1) testvec (cons butn res))))))
;; now assemble the hdrlst and bdylst and kick off the dialog
(iup:show
(iup:dialog
#:title (conc "Megatest dashboard " (current-user-name) ":" *toppath*)
#:menu (dcommon:main-menu)
(let* ((runs-view (iup:vbox
(iup:split
#:orientation "VERTICAL" ;; "HORIZONTAL"
#:value 150
(dboard:runs-tree-browser commondat runs-dat)
(apply iup:hbox
(cons (apply iup:vbox lftlst)
(list
(iup:vbox
;; the header
(apply iup:hbox (reverse hdrlst))
(apply iup:hbox (reverse bdylst))))))
;; controls
(apply iup:hbox
(cons (apply iup:vbox lftlst)
(list
(iup:vbox
;; the header
(apply iup:hbox (reverse hdrlst))
(apply iup:hbox (reverse bdylst)))))))
controls
))
;; (data (dboard:tabdat-init (make-d:data)))
(tabs (iup:tabs
#:tabchangepos-cb (lambda (obj curr prev)
(debug:catch-and-dump
(lambda ()
(let* ((tab-num (dboard:commondat-curr-tab-num commondat))
|
| ︙ | | |