Overview
| Comment: | Target selector done |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | runcontrol |
| Files: | files | file ages | folders |
| SHA1: |
5a564436634284a82626d4e59be2516d |
| 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 |
(let ((val (iup:attribute lb "VALUE")))
(if val
val
(let ((newval (car values)))
(iup:attribute-set! lb "VALUE" newval)
newval)))))
| | < < | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < | < < < < < | | < < < | | 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)
;;
|
| ︙ | ︙ |