Megatest

Check-in [9b87dc654f]
Login
Overview
Comment:Switch to changing font color from button color.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: 9b87dc654f87101ae2b2bf78496731460bce432e
User & Date: mrwellan on 2020-12-21 16:55:48
Other Links: branch diff | manifest | tags
Context
2020-12-22
15:07
Make text bold on buttons check-in: fe23e23b3c user: mrwellan tags: v1.65
2020-12-21
16:55
Switch to changing font color from button color. check-in: 9b87dc654f user: mrwellan tags: v1.65
2020-12-17
14:05
Turn back on aborting of server starts when there are enough running and use at to move them out of the way 10 minutes after they are created. check-in: 709d4974b2 user: mrwellan tags: v1.65
Changes

Modified dashboard-tests.scm from [237d160a6c] to [775d2ec086].

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)

Modified dashboard.scm from [627ca6b765] to [fdd3dbd290].

1167
1168
1169
1170
1171
1172
1173
1174


1175
1176
1177
1178
1179
1180
1181
1167
1168
1169
1170
1171
1172
1173

1174
1175
1176
1177
1178
1179
1180
1181
1182







-
+
+







					  (else
					   teststate)))
			   (button     (vector-ref columndat rown))
			   (color      (car (gutils:get-color-for-state-status teststate teststatus)))
			   (curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR"))
			   (curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE")))
		      (if (not (equal? curr-color color))
			  (iup:attribute-set! button "BGCOLOR" color))
			  #;(iup:attribute-set! button "BGCOLOR" color)
			  (iup:attribute-set! button "FGCOLOR" color))
		      (if (not (equal? curr-title buttontxt))
			  (iup:attribute-set! button "TITLE"   buttontxt))
		      (vector-set! buttondat 0 run-id)
		      (vector-set! buttondat 1 color)
		      (vector-set! buttondat 2 buttontxt)
		      (vector-set! buttondat 3 testdat)
		      (vector-set! buttondat 4 run-key)))
2498
2499
2500
2501
2502
2503
2504
2505
2506


2507
2508
2509
2510
2511
2512
2513


2514
2515
2516


2517
2518
2519
2520
2521
2522
2523
2499
2500
2501
2502
2503
2504
2505


2506
2507
2508
2509
2510
2511
2512


2513
2514
2515


2516
2517
2518
2519
2520
2521
2522
2523
2524







-
-
+
+





-
-
+
+

-
-
+
+







	   ;; 					   (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)
					     (iup:attribute-set! hide "FGCOLOR" sel-color)
					     (iup:attribute-set! show "FGCOLOR" 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)
					     (iup:attribute-set! show "FGCOLOR" sel-color)
					     (iup:attribute-set! hide "FGCOLOR" nonsel-color)
					     (mark-for-update tabdat))))
	   (iup:attribute-set! hide "BGCOLOR" sel-color)
	   (iup:attribute-set! show "BGCOLOR" nonsel-color)
	   (iup:attribute-set! hide "FGCOLOR" sel-color)
	   (iup:attribute-set! show "FGCOLOR" nonsel-color)
	   ;; (dboard:tabdat-hide-not-hide-button-set! tabdat hideit) ;; never used, can eliminate ...
           (iup:vbox
            (iup:hbox hide show)
            sort-lb))) 
	)

        ;; insert extra widget here