322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
|
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
|
-
-
+
+
|
(map cadr *common:std-states*)))) ;; (list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "LAUNCHED" "KILLED" "KILLREQ"))))
(vector-set! *state-status* 0
(lambda (state color)
(for-each
(lambda (btn)
(let* ((name (iup:attribute btn "TITLE"))
(newcolor (if (equal? name state) color "192 192 192")))
(if (not (colors-similar? newcolor (iup:attribute btn "BGCOLOR")))
(iup:attribute-set! btn "BGCOLOR" newcolor))))
(if (not (colors-similar? newcolor (iup:attribute btn "FGCOLOR")))
(iup:attribute-set! btn "FGCOLOR" newcolor))))
btns)))
btns))
(apply iup:hbox
(iup:label "STATUS:" #:size "30x")
(let* ((btns (map (lambda (status)
(let ((btn (iup:button status
#:expand "HORIZONTAL" #:size "50x" #:font "Courier New, -10"
|
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
|
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
|
-
-
+
+
|
(map cadr *common:std-statuses*)))) ;; (list "PASS" "WARN" "FAIL" "CHECK" "n/a" "WAIVED" "SKIP"))))
(vector-set! *state-status* 1
(lambda (status color)
(for-each
(lambda (btn)
(let* ((name (iup:attribute btn "TITLE"))
(newcolor (if (equal? name status) color "192 192 192")))
(if (not (colors-similar? newcolor (iup:attribute btn "BGCOLOR")))
(iup:attribute-set! btn "BGCOLOR" newcolor))))
(if (not (colors-similar? newcolor (iup:attribute btn "FGCOLOR")))
(iup:attribute-set! btn "FGCOLOR" newcolor))))
btns)))
btns))))))
(define (dashboard-tests:run-a-step info)
#t)
;; (define (dashboard-tests:step-run-control testdat stepname testconfig)
|