| ︙ | | |
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
|
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
|
-
+
|
"iup:canvas action")))
#:wheel-cb (lambda (obj step x y dir) ;; dir is 4 for up and 5 for down. I think.
(debug:catch-and-dump
(lambda ()
(let* ((drawing (dboard:tabdat-drawing tabdat))
(scalex (vg:drawing-scalex drawing)))
(dboard:tabdat-view-changed-set! tabdat #t)
(print "step: " step " x: " x " y: " y " dir: " dir " scalex: " scalex)
;; (print "step: " step " x: " x " y: " y " dir: " dir " scalex: " scalex)
(vg:drawing-scalex-set! drawing
(+ scalex
(if (> step 0)
(* scalex 0.02)
(* scalex -0.02))))))
"wheel-cb"))
)))
|
| ︙ | | |
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
|
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
|
-
+
|
"Clean Complete Run"
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -remove-runs -target " target
" -runname " runname
" -testpatt % "))))
(iup:menu-item
(iup:menu-item ;; RADT => itemize this run lists before merging with v1.61
"Kill Complete Run"
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -set-state-status KILLREQ,n/a -target " target
" -runname " runname
" -testpatt % "
|
| ︙ | | |
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
|
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
|
-
+
|
(else
(let ((labl (iup:button "" ;; the testname labels
#:flat "YES"
#:alignment "ALEFT"
; #:image img1
; #:impress img2
#:size (conc cell-width btn-height)
#:expand "NO" ;; "HORIZONTAL"
#: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
|
| ︙ | | |
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
|
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
|
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
|
#: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)
(iup:split
;; left most block, including row names
(apply iup:vbox lftlst)
(list
(iup:vbox
;; the header
(apply iup:hbox (reverse hdrlst))
(apply iup:hbox (reverse bdylst)))))))
|
| ︙ | | |
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
|
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
|
-
+
-
+
|
(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") ","))))
(let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ",")))) ;; RADT couldn't find string->number, though it works
(if (> (length d) 1)
d
(list #f #f))))
(run-id (car dat))
(test-id (cadr dat)))
(if (and (number? run-id)
(number? test-id)
(>= test-id 0))
(examine-test run-id test-id)
(dashboard-tests:examine-test run-id test-id)
(begin
(debug:print 3 *default-log-port* "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test"))
(exit 1)))))
;; ((args:get-arg "-guimonitor")
;; (gui-monitor (dboard:tabdat-dblocal tabdat)))
(else
(dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat)) ;; (dboard:tabdat-dblocal data)
|
| ︙ | | |