Overview
Comment: | Basic target updating on run control in place |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | runcontrol |
Files: | files | file ages | folders |
SHA1: |
4df25afb3e448c71abc0a28594dfede2 |
User & Date: | matt on 2013-04-20 22:42:37 |
Other Links: | branch diff | manifest | tags |
Context
2013-04-21
| ||
00:46 | Dynamic updating of target listboxes mostly working check-in: 2bf1a8a2da user: matt tags: runcontrol | |
2013-04-20
| ||
22:42 | Basic target updating on run control in place check-in: 4df25afb3e user: matt tags: runcontrol | |
22:41 | Fix to margs? check-in: a29af7bffd user: matt tags: runcontrol | |
Changes
Modified dashboard-tests.scm from [5fb3616b7a] to [3e5475f076].
︙ | ︙ | |||
474 475 476 477 478 479 480 | (db:test-data-get-type x) (db:test-data-get-comment x))) (open-run-close db:read-test-data #f test-id "%"))) "\n"))) (if (not (equal? currval newval)) (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval))))) test-data)) | | > | 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 | (db:test-data-get-type x) (db:test-data-get-comment x))) (open-run-close db:read-test-data #f test-id "%"))) "\n"))) (if (not (equal? currval newval)) (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval))))) test-data)) ;;(dashboard:run-controls) ))) (iup:attribute-set! tabs "TABTITLE0" "Steps") (iup:attribute-set! tabs "TABTITLE1" "Test Data") tabs)))) (iup:show self) (iup:callback-set! *tim* "ACTION_CB" (lambda (x) ;; Now start keeping the gui updated from the db |
︙ | ︙ |
Modified dashboard.scm from [a699a04ab1] to [c67eed6952].
︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 | (require-library iup) (import (prefix iup iup:)) (use canvas-draw) (use sqlite3 srfi-1 posix regex regex-case srfi-69) (import (prefix sqlite3 sqlite3:)) (declare (uses common)) (declare (uses margs)) (declare (uses keys)) (declare (uses items)) (declare (uses db)) (declare (uses configf)) | > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | (require-library iup) (import (prefix iup iup:)) (use canvas-draw) (use sqlite3 srfi-1 posix regex regex-case srfi-69) (import (prefix sqlite3 sqlite3:)) (use trace) (declare (uses common)) (declare (uses margs)) (declare (uses keys)) (declare (uses items)) (declare (uses db)) (declare (uses configf)) |
︙ | ︙ | |||
446 447 448 449 450 451 452 | ;; 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)) | | | | > | | > > > > > | 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 | ;; 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 (delete-duplicates (map car (filter list? remvalues)))) (sel-valnum (iup:attribute lb "VALUE")) (sel-val (iup:attribute lb sel-valnum)) (val-num 1)) ;; 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) (iup:attribute-set! lb (conc val-num) val) (if (equal? sel-val val) (iup:attribute-set! lb "VALUE" val-num)) (set! val-num (+ val-num 1))) values) (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)) |
︙ | ︙ | |||
484 485 486 487 488 489 490 | ;; Target selectors (apply iup:hbox (let loop ((key (car header)) (remkeys (cdr header)) (refvals '()) (indx 0) (lbs '())) | | | | | | | | | | | | > > > > | 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 | ;; 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 (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)))))))))))) (trace dashboard:populate-target-dropdown common:list-is-sublist) ;; ;; key1 key2 key3 ... ;; ;; target entry (wild cards allowed) ;; ;; ;; The action ;; (iup:hbox ;; ;; label Action | action selector ;; )) |
︙ | ︙ |