Overview
| Comment: | Partially complete generation of command line for local running |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | dev |
| Files: | files | file ages | folders |
| SHA1: |
57b2d5e1f5b09e4bfbd2e27954ddd90e |
| User & Date: | matt on 2013-07-07 13:16:06 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-07-07
| ||
| 15:19 | More command line launching support done check-in: 528c8eab48 user: matt tags: dev | |
| 13:16 | Partially complete generation of command line for local running check-in: 57b2d5e1f5 user: matt tags: dev | |
| 01:00 | Moved log panel to span entire bottom width. check-in: f4535b4813 user: matt tags: dev | |
Changes
Modified dashboard.scm from [bf6de7cc1c] to [741829247b].
| ︙ | ︙ | |||
153 154 155 156 157 158 159 |
(define (message-window msg)
(iup:show
(iup:dialog
(iup:vbox
(iup:label msg #:margin "40x40")))))
| | | < | | | 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 |
(define (message-window msg)
(iup:show
(iup:dialog
(iup:vbox
(iup:label msg #:margin "40x40")))))
(define (iuplistbox-fill-list lb items #!key (selected-item #f))
(let ((i 1))
(for-each (lambda (item)
(iup:attribute-set! lb (number->string i) item)
(if selected-item
(if (equal? selected-item item)
(iup:attribute-set! lb "VALUE" i))) ;; (number->string i))))
(set! i (+ i 1)))
items)
;; (iup:attribute-set! lb "VALUE" (if selected-item selected-item ""))
i))
(define (pad-list l n)(append l (make-list (- n (length l)))))
(define (colors-similar? color1 color2)
(let* ((c1 (map string->number (string-split color1)))
(c2 (map string->number (string-split color2)))
|
| ︙ | ︙ | |||
506 507 508 509 510 511 512 | (let ((all (hash-table-keys alltgls))) (proc all))))) items)))) ;; Extract the various bits of data from *data* and create the command line equivalent that will be displayed ;; (define (dashboard:update-run-command) | > > > > > > > > > > > > > > > > > > > > | > > > > > > > > | 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 545 546 547 |
(let ((all (hash-table-keys alltgls)))
(proc all)))))
items))))
;; Extract the various bits of data from *data* and create the command line equivalent that will be displayed
;;
(define (dashboard:update-run-command)
(let* ((cmd-tb (dboard:data-get-command-tb *data*))
(cmd (dboard:data-get-command *data*))
(test-patt (dboard:data-get-test-patts *data*))
(states (dboard:data-get-states *data*))
(statuses (dboard:data-get-statuses *data*))
(target (dboard:data-get-target *data*))
(states-str (if (or (not states)
(null? states))
""
(conc " :state " (string-intersperse states ","))))
(statuses-str (if (or (not statuses)
(null? statuses))
""
(conc " :status " (string-intersperse statuses ","))))
(full-cmd "megatest"))
(case (string->symbol cmd)
((runtests)
(set! full-cmd (conc full-cmd
" -runtests "
(if (equal? test-patt "") "%" test-patt) " "
" -target "
(if target (string-intersperse target "/") "no-target-selected")
" :runname "
" somerun " ;; addme!
states-str
statuses-str
)))
(else (set! full-cmd " no valid command ")))
(iup:attribute-set! cmd-tb "VALUE" full-cmd)))
(define (dashboard:draw-tests cnv xadj yadj test-draw-state sorted-testnames)
(canvas-clear! cnv)
(canvas-font-set! cnv "Courier New, -10")
(let-values (((sizex sizey sizexmm sizeymm) (canvas-size cnv))
((originx originy) (canvas-origin cnv)))
(if (hash-table-ref/default test-draw-state 'first-time #t)
|
| ︙ | ︙ | |||
570 571 572 573 574 575 576 | (sorted-testnames #f) (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) | > > | > | | | | > > > > > | > | | > > > > > | > | > > | | | | 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 |
(sorted-testnames #f)
(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)
(let ((targ (map (lambda (x)
(iup:attribute x "VALUE"))
(car (dashboard:update-target-selector key-listboxes)))))
(dboard:data-set-target! *data* targ)
(dashboard:update-run-command))))
(tests-draw-state (make-hash-table))) ;; use for keeping state of the test canvas
(hash-table-set! tests-draw-state 'first-time #t)
(hash-table-set! tests-draw-state 'scalef 8)
(tests:get-full-data test-names test-records '())
(set! sorted-testnames (tests:sort-by-priority-and-waiton test-records))
;; refer to *keys*, *dbkeys* for keys
(iup:vbox
;; The command line display/exectution control
(iup:hbox
(iup:label "Run on" #:size "40x")
(iup:radio
(iup:hbox
(iup:toggle "Local" #:size "40x")
(iup:toggle "Server" #:size "40x")))
(let ((tb (iup:textbox
#:value "megatest "
#:expand "HORIZONTAL"
#:readonly "YES"
)))
(dboard:data-set-command-tb! *data* tb)
tb)
(iup:button "Execute" #:size "50x"))
(iup:split
#:orientation "HORIZONTAL"
(iup:split
;; Target, testpatt, state and status input boxes
#:value 300
(iup:vbox
;; Command to run
(iup:frame
#:title "Set the action to take"
(iup:hbox
(iup:label "Command to run" #:expand "HORIZONTAL" #:size "70x" #:alignment "LEFT:ACENTER")
(let* ((cmds-list '("runtests" "remove-runs" "set-state-status"))
(lb (iup:listbox #:expand "HORIZONTAL"
#:dropdown "YES"
#:action (lambda (obj val index lbstate)
;; (print obj " " val " " index " " lbstate)
(dboard:data-set-command! *data* val)
(dashboard:update-run-command))))
(default-cmd (car cmds-list)))
(iuplistbox-fill-list lb cmds-list selected-item: default-cmd)
(dboard:data-set-command! *data* default-cmd)
lb)))
(iup:frame
#:title "Selectors that determine which tests will be operated on"
(iup:vbox
;; Text box for test patterns
(iup:frame
#:title "Test patterns (one per line)"
(iup:textbox #:action (lambda (val a b)
(dboard:data-set-test-patts!
*data*
(dboard:lines->test-patt b))
(dashboard:update-run-command))
#:value (dboard:test-patt->lines
(dboard:data-get-test-patts *data*))
#:expand "YES"
#:multiline "YES"))
(iup:frame
#:title "Target"
;; 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)))
(iup:hbox
;; Text box for STATES
(iup:frame
#:title "States"
(dashboard:text-list-toggle-box
;; Move these definitions to common and find the other useages and replace!
'("COMPLETED" "RUNNING" "STUCK" "INCOMPLETE" "LAUNCHED" "REMOTEHOSTSTART" "KILLED")
(lambda (all)
(dboard:data-set-states! *data* all)
(dashboard:update-run-command))))
;; Text box for STATES
(iup:frame
#:title "Statuses"
(dashboard:text-list-toggle-box
'("PASS" "FAIL" "n/a" "CHECK" "WAIVED" "SKIP" "DELETED" "STUCK/DEAD")
(lambda (all)
(dboard:data-set-statuses! *data* all)
(dashboard:update-run-command))))))))
(iup:frame
#:title "Tests and Tasks"
(iup:canvas #:action (make-canvas-action
(lambda (cnv xadj yadj)
;; (print "cnv: " cnv " x: " x " y: " y)
|
| ︙ | ︙ |
Modified dcommon.scm from [36076daa84] to [cf58132549].
| ︙ | ︙ | |||
33 34 35 36 37 38 39 | ;; C O M M O N D A T A S T R U C T U R E ;;====================================================================== ;; ;; A single data structure for all the data used in a dashboard. ;; Share this structure between newdashboard and dashboard with the ;; intent of converging on a single app. ;; | | | | > > > > | | | | > > | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | ;; C O M M O N D A T A S T R U C T U R E ;;====================================================================== ;; ;; A single data structure for all the data used in a dashboard. ;; Share this structure between newdashboard and dashboard with the ;; intent of converging on a single app. ;; (define *data* (make-vector 20 #f)) (define (dboard:data-get-runs vec) (vector-ref vec 0)) (define (dboard:data-get-tests vec) (vector-ref vec 1)) (define (dboard:data-get-runs-matrix vec) (vector-ref vec 2)) (define (dboard:data-get-tests-tree vec) (vector-ref vec 3)) (define (dboard:data-get-run-keys vec) (vector-ref vec 4)) (define (dboard:data-get-curr-test-ids vec) (vector-ref vec 5)) ;; (define (dboard:data-get-test-details vec) (vector-ref vec 6)) (define (dboard:data-get-path-test-ids vec) (vector-ref vec 7)) (define (dboard:data-get-updaters vec) (vector-ref vec 8)) (define (dboard:data-get-path-run-ids vec) (vector-ref vec 9)) (define (dboard:data-get-curr-run-id vec) (vector-ref vec 10)) (define (dboard:data-get-runs-tree vec) (vector-ref vec 11)) ;; For test-patts convert #f to "" (define (dboard:data-get-test-patts vec) (let ((val (vector-ref vec 12)))(if val val ""))) (define (dboard:data-get-states vec) (vector-ref vec 13)) (define (dboard:data-get-statuses vec) (vector-ref vec 14)) (define (dboard:data-get-logs-textbox vec val)(vector-ref vec 15)) (define (dboard:data-get-command vec) (vector-ref vec 16)) (define (dboard:data-get-command-tb vec) (vector-ref vec 17)) (define (dboard:data-get-target vec) (vector-ref vec 18)) (define (dboard:data-set-runs! vec val)(vector-set! vec 0 val)) (define (dboard:data-set-tests! vec val)(vector-set! vec 1 val)) (define (dboard:data-set-runs-matrix! vec val)(vector-set! vec 2 val)) (define (dboard:data-set-tests-tree! vec val)(vector-set! vec 3 val)) (define (dboard:data-set-run-keys! vec val)(vector-set! vec 4 val)) (define (dboard:data-set-curr-test-ids! vec val)(vector-set! vec 5 val)) ;; (define (dboard:data-set-test-details! vec val)(vector-set! vec 6 val)) (define (dboard:data-set-path-test-ids! vec val)(vector-set! vec 7 val)) (define (dboard:data-set-updaters! vec val)(vector-set! vec 8 val)) (define (dboard:data-set-path-run-ids! vec val)(vector-set! vec 9 val)) (define (dboard:data-set-curr-run-id! vec val)(vector-set! vec 10 val)) (define (dboard:data-set-runs-tree! vec val)(vector-set! vec 11 val)) ;; For test-patts convert "" to #f (define (dboard:data-set-test-patts! vec val) (vector-set! vec 12 (if (equal? val "") #f val))) (define (dboard:data-set-states! vec val)(vector-set! vec 13 val)) (define (dboard:data-set-statuses! vec val)(vector-set! vec 14 val)) (define (dboard:data-set-logs-textbox! vec val)(vector-set! vec 15 val)) (define (dboard:data-set-command! vec val)(vector-set! vec 16 val)) (define (dboard:data-set-command-tb! vec val)(vector-set! vec 17 val)) (define (dboard:data-set-target! vec val)(vector-set! vec 18 val)) (dboard:data-set-run-keys! *data* (make-hash-table)) ;; List of test ids being viewed in various panels (dboard:data-set-curr-test-ids! *data* (make-hash-table)) ;; Look up test-ids by (key1 key2 ... testname [itempath]) |
| ︙ | ︙ |