Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -155,21 +155,20 @@ (iup:show (iup:dialog (iup:vbox (iup:label msg #:margin "40x40"))))) -(define (iuplistbox-fill-list lb items . default) - (let ((i 1) - (selected-item (if (null? default) #f (car default)))) +(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" item))) ;; (number->string i)))) + (iup:attribute-set! lb "VALUE" i))) ;; (number->string i)))) (set! i (+ i 1))) items) - (iup:attribute-set! lb "VALUE" (if selected-item selected-item "")) + ;; (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) @@ -508,11 +507,39 @@ items)))) ;; Extract the various bits of data from *data* and create the command line equivalent that will be displayed ;; (define (dashboard:update-run-command) - (print "Updated!!")) + (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)) @@ -572,12 +599,15 @@ (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) - )) + (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)) @@ -589,29 +619,41 @@ (iup:label "Run on" #:size "40x") (iup:radio (iup:hbox (iup:toggle "Local" #:size "40x") (iup:toggle "Server" #:size "40x"))) - (iup:textbox - #:value "megatest -xyz" - #:expand "HORIZONTAL") + (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") - (let ((lb (iup:listbox #:expand "HORIZONTAL" - #:dropdown "YES"))) - (iuplistbox-fill-list lb '("-runtests" "-remove-runs" "-set-state-status") "-runtests") + (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 @@ -618,11 +660,12 @@ (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))) + (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 @@ -637,21 +680,22 @@ (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* (string-intersperse all ",")) + (dboard:data-set-states! *data* all) (dashboard:update-run-command)))) ;; Text box for STATES (iup:frame - #:title "States" + #:title "Statuses" (dashboard:text-list-toggle-box '("PASS" "FAIL" "n/a" "CHECK" "WAIVED" "SKIP" "DELETED" "STUCK/DEAD") (lambda (all) - (dboard:data-set-statuses! *data* (string-intersperse all ",")) + (dboard:data-set-statuses! *data* all) (dashboard:update-run-command)))))))) (iup:frame #:title "Tests and Tasks" (iup:canvas #:action (make-canvas-action Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -35,11 +35,11 @@ ;; ;; 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 15 #f)) +(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)) @@ -51,12 +51,16 @@ (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 12)) -(define (dboard:data-get-statuses vec) (vector-ref vec 13)) +(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)) @@ -69,14 +73,16 @@ (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 12 val)) -(define (dboard:data-set-statuses! vec val)(vector-set! vec 13 val)) -(define (dboard:data-set-logs-textbox! vec val)(vector-set! vec 14 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))