︙ | | | ︙ | |
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================
(declare (unit dcommon))
(module dcommon
*
(import scheme
chicken.base
chicken.condition
chicken.string
chicken.pretty-print
chicken.sort
chicken.time
chicken.file
chicken.file.posix
chicken.process
chicken.process-context
chicken.process-context.posix
srfi-18
format
iup
(prefix iup iup:)
canvas-draw
regex
typed-records
matchable
srfi-69
sparse-vectors
srfi-1
)
(declare (uses gutils))
(declare (uses dbmod))
(declare (uses mtver))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses rmtmod))
;; (include "megatest-version.scm")
;; (include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
(import
mtver
dbmod
commonmod
debugprint
configfmod
rmtmod
gutils
)
;; yes, this is non-ideal
(define dashboard:update-summary-tab #f)
(define dashboard:update-servers-table #f)
(define *last-monitor-update-time* 0)
;;======================================================================
;; C O M M O N D A T A S T R U C T U R E
;;======================================================================
;;
;; data common to all tabs goes here
;;
|
>
>
>
>
>
>
>
>
>
>
|
|
|
>
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
|
|
|
|
|
|
>
>
|
>
>
>
>
>
>
>
|
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================
(declare (unit dcommon))
(declare (uses gutils))
(declare (uses dbmod))
(declare (uses mtver))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses rmtmod))
(declare (uses mtargs))
(declare (uses testsmod))
(module dcommon
*
(import scheme
chicken.base
chicken.condition
chicken.string
chicken.pretty-print
chicken.sort
chicken.time
chicken.file
chicken.file.posix
chicken.port
chicken.process
chicken.process-context
chicken.process-context.posix)
(import srfi-18
format
iup
(prefix iup iup:)
canvas-draw
canvas-draw-iup
regex
typed-records
matchable
srfi-69
sparse-vectors
srfi-1
)
(import mtver
dbmod
commonmod
debugprint
configfmod
rmtmod
gutils
(prefix mtargs args:)
testsmod)
;; (include "megatest-version.scm")
(include "common_records.scm")
;; (include "db_records.scm")
;; (include "key_records.scm")
;; (include "run_records.scm")
;; yes, this is non-ideal
(define dashboard:update-summary-tab #f)
(define dashboard:update-servers-table #f)
(define *last-monitor-update-time* 0)
(define *exit-started* #f)
;;======================================================================
;; C O M M O N D A T A S T R U C T U R E
;;======================================================================
;;
;; data common to all tabs goes here
;;
|
︙ | | | ︙ | |
257
258
259
260
261
262
263
264
265
266
267
268
269
270
|
(runs-summary-source-runname-label #f)
(runs-summary-dest-runname-label #f)
;; runs summary view
tests-tree ;; used in newdashboard
)
;;======================================================================
;; D O T F I L E
;;======================================================================
(define (dcommon:write-dotfile fname dat)
(with-output-to-file fname
|
>
>
>
>
>
>
|
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
|
(runs-summary-source-runname-label #f)
(runs-summary-dest-runname-label #f)
;; runs summary view
tests-tree ;; used in newdashboard
)
;; additional setters for dboard:data
(define (dboard:tabdat-test-patts-set!-use vec val)
(dboard:tabdat-test-patts-set! vec (if (equal? val "") #f val)))
(define (dboard:tabdat-test-patts-use vec)
(let ((val (dboard:tabdat-test-patts vec)))(if val val ""))) ;;RADT => What is the if for?
;;======================================================================
;; D O T F I L E
;;======================================================================
(define (dcommon:write-dotfile fname dat)
(with-output-to-file fname
|
︙ | | | ︙ | |
844
845
846
847
848
849
850
851
852
853
854
855
856
857
|
(if (not (equal? (iup:attribute stats-matrix key) value))
(begin
(set! changed #t)
(iup:attribute-set! stats-matrix key value)))))
run-stats)
(if changed (iup:attribute-set! stats-matrix "REDRAW" "ALL")))))
(define (dcommon:run-stats commondat tabdat #!key (tab-num #f))
(let* ((stats-matrix (iup:matrix expand: "YES"))
(stats-updater (lambda ()
(dcommon:stats-updater commondat tabdat stats-matrix))))
;; (dboard:commondat-please-update-set! commondat #t) ;; force redraw on first pass
;; (mark-for-update tabdat)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
|
(if (not (equal? (iup:attribute stats-matrix key) value))
(begin
(set! changed #t)
(iup:attribute-set! stats-matrix key value)))))
run-stats)
(if changed (iup:attribute-set! stats-matrix "REDRAW" "ALL")))))
;; if tab-num passed in then use it, otherwise look in commondat at curr-tab-num
;; adds the updater passed in the updaters list at that hashkey
;;
(define (dboard:commondat-add-updater commondat updater #!key (tab-num #f))
(let* ((tnum (or tab-num
(dboard:commondat-curr-tab-num commondat)))
(curr-updaters (hash-table-ref/default (dboard:commondat-updaters commondat) tnum '())))
(hash-table-set! (dboard:commondat-updaters commondat)
tnum
(cons updater curr-updaters))))
;; ;; if tab-num passed in then use it, otherwise look in commondat at curr-tab-num
;; ;; adds the updater passed in the updaters list at that hashkey
;; ;;
;; (define (dboard:commondat-add-updater commondat updater #!key (tab-num #f))
;; (let* ((tnum (or tab-num
;; (dboard:commondat-curr-tab-num commondat)))
;; (curr-updaters (hash-table-ref/default (dboard:commondat-updaters commondat) tnum '())))
;; (hash-table-set! (dboard:commondat-updaters commondat)
;; tnum
;; (cons updater curr-updaters))))
;;
(define (dcommon:run-stats commondat tabdat #!key (tab-num #f))
(let* ((stats-matrix (iup:matrix expand: "YES"))
(stats-updater (lambda ()
(dcommon:stats-updater commondat tabdat stats-matrix))))
;; (dboard:commondat-please-update-set! commondat #t) ;; force redraw on first pass
;; (mark-for-update tabdat)
|
︙ | | | ︙ | |
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
|
tb)
(iup:button "Execute" #:size "50x"
#:action (lambda (obj)
;; (let ((cmd (conc ;; "xterm -geometry 180x20 -e \""
(common:run-a-command (iup:attribute (dboard:tabdat-command-tb data) "VALUE")))))))
;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
;; (system cmd)))))))
(define (dcommon:command-action-selector commondat tabdat #!key (tab-num #f))
(iup:frame
#:title "Set the action to take"
(iup:hbox
;; (iup:label "Command to run" #:expand "HORIZONTAL" #:size "70x" #:alignment "LEFT:ACENTER")
(let* ((cmds-list '("run" "remove-runs")) ;; "set-state-status" "lock-runs" "unlock-runs"))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
|
tb)
(iup:button "Execute" #:size "50x"
#:action (lambda (obj)
;; (let ((cmd (conc ;; "xterm -geometry 180x20 -e \""
(common:run-a-command (iup:attribute (dboard:tabdat-command-tb data) "VALUE")))))))
;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
;; (system cmd)))))))
;; Extract the various bits of data from tabdat and create the command line equivalent that will be displayed
;;
(define (dashboard:update-run-command tabdat)
(let* ((cmd-tb (dboard:tabdat-command-tb tabdat))
(cmd (dboard:tabdat-command tabdat))
(test-patt (let ((tp (dboard:tabdat-test-patts tabdat)))
(if (or (not tp)
(equal? tp ""))
"%"
tp)))
(states (dboard:tabdat-states tabdat))
(statuses (dboard:tabdat-statuses tabdat))
(target (let ((targ-list (dboard:tabdat-target tabdat)))
(if targ-list (string-intersperse targ-list "/") "no-target-selected")))
(run-name (dboard:tabdat-run-name tabdat))
(states-str (if (or (not states)
(null? states))
""
(conc " -state " (string-intersperse states ","))))
(statuses-str (if (or (not statuses)
(null? statuses))
""
(conc " -status " (string-intersperse statuses ","))))
(full-cmd "megatest"))
(case (string->symbol cmd)
((run)
(set! full-cmd (conc full-cmd
" -run"
" -testpatt "
test-patt
" -target "
target
" -runname "
run-name
" -clean-cache"
)))
((remove-runs)
(set! full-cmd (conc full-cmd
" -remove-runs -runname "
run-name
" -target "
target
" -testpatt "
test-patt
states-str
statuses-str
)))
(else (set! full-cmd " no valid command ")))
(iup:attribute-set! cmd-tb "VALUE" full-cmd)))
(define (dcommon:command-action-selector commondat tabdat #!key (tab-num #f))
(iup:frame
#:title "Set the action to take"
(iup:hbox
;; (iup:label "Command to run" #:expand "HORIZONTAL" #:size "70x" #:alignment "LEFT:ACENTER")
(let* ((cmds-list '("run" "remove-runs")) ;; "set-state-status" "lock-runs" "unlock-runs"))
|
︙ | | | ︙ | |