Megatest

Check-in [5a56443663]
Login
Overview
Comment:Target selector done
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | runcontrol
Files: files | file ages | folders
SHA1: 5a564436634284a82626d4e59be2516dda8f8037
User & Date: matt on 2013-04-21 01:24:31
Other Links: branch diff | manifest | tags
Context
2013-04-22
00:59
Display of tests on canvas partially implemented check-in: efa1af53d5 user: matt tags: runcontrol
2013-04-21
01:24
Target selector done check-in: 5a56443663 user: matt tags: runcontrol
00:46
Dynamic updating of target listboxes mostly working check-in: 2bf1a8a2da user: matt tags: runcontrol
Changes

Modified dashboard.scm from [9c22af910c] to [5c1a3909e7].

468
469
470
471
472
473
474
475
476
477
478
479
480






































481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
    (let ((val (iup:attribute lb "VALUE")))
      (if val
	  val
	  (let ((newval (car values)))
	    (iup:attribute-set! lb "VALUE" newval)
	    newval)))))

(define (dashboard:run-controls)
  (let* ((targets       (make-hash-table))
	 (runconf-targs (common:get-runconfig-targets))
	 (db-target-dat (open-run-close db:get-targets #f))
	 (header        (vector-ref db-target-dat 0))
	 (db-targets    (vector-ref db-target-dat 1))






































	 (tests         (make-hash-table))
	 (action        "-runtests")
	 (cmdln         "")
	 (runlogs       (make-hash-table))
	 (key-listboxes #f)
	 (update-target (lambda (a b c d)
			  (let* ((db-target-dat (open-run-close db:get-targets #f))
				 (db-targets    (vector-ref db-target-dat 1)))
			    (let loop ((key     (car header))
				       (remkeys (cdr header))
				       (refvals '())
				       (indx    0)
				       (lbs     '()))
			      (let* ((lb (list-ref key-listboxes indx))
				     ;; loop though all the targets and build the list for this dropdown
				     (selected-value (dashboard:populate-target-dropdown lb refvals db-targets)))
				(if (null? remkeys)
				    (append lbs (list lb))
				    (loop (car remkeys)
					  (cdr remkeys)
					  (append refvals (list selected-value))
					  (+ indx 1)
					  (append lbs (list lb))))))))))
    ;; refer to *keys*, *dbkeys* for keys
    (print "db-targets: " db-targets)
    (iup:vbox
     (iup:hbox
       ;; Target and action
      (iup:vbox
        ;; Target selectors
        (apply iup:hbox
	       (let ((key-lb
		      (let loop ((key     (car header))
				 (remkeys (cdr header))
				 (refvals '())
				 (indx    0)
				 (lbs     '()))
			(let* ((lb (iup:listbox 
				    key 
				    #:size "x15" 
				    #:fontsize "10"
				    #:expand "YES"
				    ;; #:dropdown "YES"
				    #:editbox "YES"
				    #:action update-target
				    ))
			       ;; loop though all the targets and build the list for this dropdown
			       (selected-value (dashboard:populate-target-dropdown lb refvals db-targets)))
			  (if (null? remkeys)
			      (append lbs (list lb))
			      (loop (car remkeys)
				    (cdr remkeys)
				    (append refvals (list selected-value))
				    (+ indx 1)
				    (append lbs (list lb))))))))
		 (set! key-listboxes key-lb)
		 key-lb)))))))

(trace dashboard:populate-target-dropdown
       common:list-is-sublist)

;;       ;; key1 key2 key3 ...
;;       ;; target entry (wild cards allowed)
;;       







|
<
<
|


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





|
|
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<

<






<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
|
|
<
<
<

|







468
469
470
471
472
473
474
475


476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523






524









525

526
527
528
529
530
531













532





533
534



535
536
537
538
539
540
541
542
543
    (let ((val (iup:attribute lb "VALUE")))
      (if val
	  val
	  (let ((newval (car values)))
	    (iup:attribute-set! lb "VALUE" newval)
	    newval)))))

(define (dashboard:update-target-selector key-lbs #!key (action-proc #f))


  (let* ((db-target-dat (open-run-close db:get-targets #f))
	 (header        (vector-ref db-target-dat 0))
	 (db-targets    (vector-ref db-target-dat 1))
	 (key-listboxes (if key-lbs key-lbs (make-list (length header) #f))))
    (let loop ((key     (car header))
	       (remkeys (cdr header))
	       (refvals '())
	       (indx    0)
	       (lbs     '()))
      (let* ((lb (let ((lb (list-ref key-listboxes indx)))
		   (if lb
		       lb
		       (iup:listbox 
			#:size "x15" 
				    #:fontsize "10"
				    #:expand "YES"
				    ;; #:dropdown "YES"
				    #:editbox "YES"
				    #:action action-proc
				    ))))
	     ;; loop though all the targets and build the list for this dropdown
	     (selected-value (dashboard:populate-target-dropdown lb refvals db-targets)))
	(if (null? remkeys)
	    ;; return a list of the listbox items and an iup:hbox with the labels and listboxes
	    (let ((listboxes (append lbs (list lb))))
	      (list listboxes
		    (map (lambda (htxt lb)
			   (iup:vbox
			    (iup:label htxt)
			    lb))
			 header
			 listboxes)))
	    (loop (car remkeys)
		  (cdr remkeys)
		  (append refvals (list selected-value))
		  (+ indx 1)
		  (append lbs (list lb))))))))

(define (dashboard:run-controls)
  (let* ((targets       (make-hash-table))
	 (runconf-targs (common:get-runconfig-targets))
	 (tests         (make-hash-table))
	 (action        "-runtests")
	 (cmdln         "")
	 (runlogs       (make-hash-table))
	 (key-listboxes #f)
	 (update-keyvals (lambda (obj b c d)
			   (print "obj: " obj ", b " b ", c " c ", d " d)






			   (dashboard:update-target-selector key-listboxes))))









    ;; refer to *keys*, *dbkeys* for keys

    (iup:vbox
     (iup:hbox
       ;; Target and action
      (iup:vbox
        ;; Target selectors
        (apply iup:hbox













	       (let* ((dat      (dashboard:update-target-selector key-listboxes action-proc: update-keyvals))





		      (key-lb   (car dat))
		      (combos   (cadr dat)))



		 (set! key-listboxes key-lb)
		 combos)))))))

(trace dashboard:populate-target-dropdown
       common:list-is-sublist)

;;       ;; key1 key2 key3 ...
;;       ;; target entry (wild cards allowed)
;;