Overview
Comment: | first cut at hierarchial selector for targets |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | runcontrol |
Files: | files | file ages | folders |
SHA1: |
b4c4ed6017bf87262ee59d912e91da84 |
User & Date: | matt on 2013-04-20 11:49:18 |
Other Links: | branch diff | manifest | tags |
Context
2013-04-20
| ||
22:41 | Fix to margs? check-in: a29af7bffd user: matt tags: runcontrol | |
11:49 | first cut at hierarchial selector for targets check-in: b4c4ed6017 user: matt tags: runcontrol | |
2013-04-19
| ||
18:12 | Minor changes for run control panel check-in: f6a292210e user: mrwellan tags: runcontrol | |
Changes
Modified common.scm from [3109b21887] to [7f9cf64fe3].
︙ | ︙ | |||
140 141 142 143 144 145 146 147 148 149 150 151 152 153 | #f #t))) string<?)) ;; '(print (string-intersperse (map cadr (hash-table-ref/default (read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))' (define (common:get-disks) (hash-table-ref/default (read-config "megatest.config" #f #t) "disks" '("none" ""))) ;;====================================================================== ;; System stuff ;;====================================================================== ;; return a nice clean pathname made absolute (define (nice-path dir) | > > > > > > > > > > > > > > > > > > > > > > > > > > | 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 | #f #t))) string<?)) ;; '(print (string-intersperse (map cadr (hash-table-ref/default (read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))' (define (common:get-disks) (hash-table-ref/default (read-config "megatest.config" #f #t) "disks" '("none" ""))) ;;====================================================================== ;; M I S C L I S T S ;;====================================================================== ;; items in lista are matched value and position in listb ;; return the remaining items in listb or #f ;; (define (common:list-is-sublist lista listb) (if (null? lista) listb ;; all items in listb are "remaining" (if (> (length lista)(length listb)) #f (let loop ((heda (car lista)) (tala (cdr lista)) (hedb (car listb)) (talb (cdr listb))) (if (equal? heda hedb) (if (null? tala) ;; we are done talb (loop (car tala) (cdr tala) (car talb) (cdr talb))) #f))))) ;;====================================================================== ;; System stuff ;;====================================================================== ;; return a nice clean pathname made absolute (define (nice-path dir) |
︙ | ︙ |
Modified dashboard.scm from [af16f05103] to [a699a04ab1].
︙ | ︙ | |||
425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 | (define (mark-for-update) (set! *last-db-update-time* 0) (set! *delayed-update* 1)) ;;====================================================================== ;; R U N C O N T R O L ;;====================================================================== (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))) ;; refer to *keys*, *dbkeys* for keys (print "db-targets: " db-targets) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | > | > | | | | | < | > | | > | | > | < | | > | 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 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 | (define (mark-for-update) (set! *last-db-update-time* 0) (set! *delayed-update* 1)) ;;====================================================================== ;; R U N C O N T R O L ;;====================================================================== ;; target populating logic ;; ;; lb = <vector curr-label-object next-label-object> ;; field = target field name for this dropdown ;; referent-vals = selected value in the left dropdown ;; targets = list of targets to use to build the dropdown ;; ;; each node is chained: key1 -> key2 -> key3 ;; ;; must select values from only apropriate targets ;; a b c ;; a d e ;; a b f ;; a/b => c f ;; (define (dashboard:populate-target-dropdown lb referent-vals targets) ;; is the current value in the new list? choose new default if not (let* ((remvalues (map (lambda (row) (common:list-is-sublist referent-vals (vector->list row))) targets)) (values (map car (filter list? remvalues))) (sel-valnum (iup:attribute lb "VALUE")) (sel-val (iup:attribute lb sel-valnum)) (val-num 0)) ;; first check if the current value is in the new list, otherwise replace with ;; first value from values (iup:attribute-set! lb "REMOVEITEM" "ALL") (for-each (lambda (val) (iup:attribute-set! lb "APPENDITEM" val) (if (equal? sel-val val) (iup:attribute-set! lb "VALUE" val-num)) (set! val-num (+ val-num 1))) values))) (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))) ;; 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 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" ))) ;; loop though all the targets and build the list for this dropdown (dashboard:populate-target-dropdown lb refvals db-targets) (if (null? remkeys) (append lbs (list lb)) (loop (car remkeys) (cdr remkeys) (append refvals (list key)) (+ indx 1) (append lbs (list lb)))))))))))) ;; ;; key1 key2 key3 ... ;; ;; target entry (wild cards allowed) ;; ;; ;; The action ;; (iup:hbox ;; ;; label Action | action selector ;; )) |
︙ | ︙ |