@@ -64,10 +64,13 @@ Usage: dashboard [options] -h : this help -test run-id,test-id : control test identified by testid -skip-version-check : skip the version check -use-db-cache : access database via cache + -target T : prefill target filter with given target pattern + -runname R : prefill runname filter with given runname pattern + -testpatt P : prefill testpatt filter with given testpatt Misc -rows R : set number of rows -cols C : set number of columns ")) @@ -86,10 +89,13 @@ "-xterm" "-debug" "-host" "-transport" "-start-dir" + "-target" ;; use as filter + "-runname" ;; use as filter + "-testpatt" ;; use as filter ) (list "-h" "-use-server" "-guimonitor" "-main" @@ -1171,13 +1177,14 @@ (button (vector-ref columndat rown)) (color (car (gutils:get-color-for-state-status teststate teststatus))) (curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR")) (curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE"))) (if (not (equal? curr-color color)) - (iup:attribute-set! button "BGCOLOR" color)) + #;(iup:attribute-set! button "BGCOLOR" color) + (iup:attribute-set! button "FGCOLOR" color)) (if (not (equal? curr-title buttontxt)) - (iup:attribute-set! button "TITLE" buttontxt)) + (iup:attribute-set! button "TITLE" (conc "" buttontxt ""))) (vector-set! buttondat 0 run-id) (vector-set! buttondat 1 color) (vector-set! buttondat 2 buttontxt) (vector-set! buttondat 3 testdat) (vector-set! buttondat 4 run-key))) @@ -1520,29 +1527,27 @@ ;; #:title "Logs" ;; To be replaced with tabs ;; (let ((logs-tb (iup:textbox #:expand "YES" ;; #:multiline "YES"))) ;; (dboard:tabdat-logs-textbox-set! tabdat logs-tb) ;; logs-tb)) + +(define (dboard:runs-tree-txtbox-change tabdat val a b) + (if b (dboard:tabdat-target-set! tabdat (string-split b "/"))) + (dashboard:update-run-command tabdat)) ;; browse runs as a tree. Used in both "Runs" tab and ;; in the runs control panel. ;; (define (dboard:runs-tree-browser commondat tabdat) (let* ((txtbox (iup:textbox #:action (lambda (val a b) (debug:catch-and-dump (lambda () - ;; for the Runs view we put the list - ;; of keyvals into tabdat target for - ;; the Run Controls we put then update - ;; the run-command - (if b (dboard:tabdat-target-set! tabdat - (string-split b "/"))) - (dashboard:update-run-command tabdat)) + (dboard:runs-tree-txtbox-change tabdat val a b)) "command-testname-selector tb action")) #:value (dboard:test-patt->lines - (dboard:tabdat-test-patts-use tabdat)) + (dboard:tabdat-test-patts-use tabdat)) #:expand "HORIZONTAL" ;; #:size "10x30" )) (tb (iup:treebox @@ -1583,10 +1588,18 @@ (debug:print-error 5 *default-log-port* "tree-path->run-id returned non-number " run-id)))) "treebox")) ;; (print "path: " (tree:node->path obj id) " run-id: " run-id) ))) (dboard:tabdat-runs-tree-set! tabdat tb) + (if (args:get-arg "-runname") + (let ((runname (args:get-arg "-runname"))) + (update-search commondat tabdat "runname" runname) + #;(hash-table-set! (dboard:tabdat-searchpatts tabdat) "runname" runname))) + (if (args:get-arg "-target") ;; + (let ((target (args:get-arg "-target"))) + (iup:attribute-set! txtbox value: target) + (dboard:runs-tree-txtbox-change tabdat #f #f target))) (iup:detachbox (iup:vbox txtbox tb )))) @@ -2485,22 +2498,22 @@ (set! hide (iup:button "Hide" #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL" #:action (lambda (obj) (dboard:tabdat-hide-not-hide-set! tabdat #t) ;; (not (dboard:tabdat-hide-not-hide tabdat))) ;; (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-not-hide tabdat) "HideTests" "NotHide")) - (iup:attribute-set! hide "BGCOLOR" sel-color) - (iup:attribute-set! show "BGCOLOR" nonsel-color) + (iup:attribute-set! hide "FGCOLOR" sel-color) + (iup:attribute-set! show "FGCOLOR" nonsel-color) (mark-for-update tabdat)))) (set! show (iup:button "Show" #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL" #:action (lambda (obj) (dboard:tabdat-hide-not-hide-set! tabdat #f) ;; (not (dboard:tabdat-hide-not-hide tabdat))) - (iup:attribute-set! show "BGCOLOR" sel-color) - (iup:attribute-set! hide "BGCOLOR" nonsel-color) + (iup:attribute-set! show "FGCOLOR" sel-color) + (iup:attribute-set! hide "FGCOLOR" nonsel-color) (mark-for-update tabdat)))) - (iup:attribute-set! hide "BGCOLOR" sel-color) - (iup:attribute-set! show "BGCOLOR" nonsel-color) + (iup:attribute-set! hide "FGCOLOR" sel-color) + (iup:attribute-set! show "FGCOLOR" nonsel-color) ;; (dboard:tabdat-hide-not-hide-button-set! tabdat hideit) ;; never used, can eliminate ... (iup:vbox (iup:hbox hide show) sort-lb))) ) @@ -2761,10 +2774,15 @@ (btn-fontsz (dboard:tabdat-runs-btn-fontsz runs-dat)) (cell-width (dboard:tabdat-runs-cell-width runs-dat))) ;; controls (along bottom) ;; (set! controls (dboard:make-controls commondat runs-dat)) + (if (args:get-arg "-runname") + (let ((runname (args:get-arg "-runname"))) + (update-search commondat runs-dat "runname" runname) + #;(hash-table-set! (dboard:tabdat-searchpatts tabdat) "runname" runname))) + ;; create the left most column for the run key names and the test names (set! lftlst (list (iup:hbox (iup:label) ;; (iup:valuator) (apply iup:vbox @@ -2776,11 +2794,12 @@ #:fontsize btn-fontsz #:expand "NO") ;; "HORIZONTAL") (iup:textbox #:size (conc 35 btn-height) #:fontsize btn-fontsz - #:value "%" + #:value (if (and (args:get-arg "-runname")(equal? x "runname")) + (args:get-arg "-runname") "%") #:expand "NO" ;; "HORIZONTAL" #:action (lambda (obj unk val) ;; each field ;; (field name is "x" var) live updates ;; the search filter as it is typed @@ -2869,10 +2888,11 @@ (let* ((button-key (mkstr runnum testnum)) (butn (iup:button "" ;; button-key #:size (conc cell-width btn-height ) #:expand "HORIZONTAL" + #:MARKUP "YES" #:fontsize btn-fontsz #:button-cb (lambda (obj a pressed x y btn . rem) ;; (print "pressed= " pressed " x= " x " y= " y " rem=" rem " btn=" btn " string? " (string? btn)) (if (substring-index "3" btn)