Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -113,21 +113,44 @@ updaters: (make-hash-table) updating: #f hide-not-hide-tabs: #f )) -(define (dboard:common-get-tabdat commondat) +(define (dboard:common-get-tabdat commondat #!key (tab-num #f)) (hash-table-ref/default (dboard:commondat-tabdats commondat) - (dboard:commondat-curr-tab-num commondat) + (or tab-num (dboard:commondat-curr-tab-num commondat)) #f)) (define (dboard:common-set-tabdat! commondat tabnum tabdat) (hash-table-set! (dboard:commondat-tabdats commondat) tabnum tabdat)) + +;; gets and calls updater based on curr-tab-num +(define (dboard:common-run-curr-updaters commondat #!key (tab-num #f)) + (if (dboard:common-get-tabdat commondat tab-num: tab-num) ;; only update if there is a tabdat + (let* ((tnum (or tab-num (dboard:commondat-curr-tab-num commondat))) + (updaters (hash-table-ref/default (dboard:commondat-updaters commondat) + tnum + '()))) + (debug:print 0 *default-log-port* "Found these updaters: " updaters) + (for-each + (lambda (updater) + (updater)) + updaters)))) + +;; if tab-num passed in then use it, otherwise look in commondat at curr-tab-num +;; +(define (dboard:commondat-add-updater commondat updater #!key (tab-num #f)) + (let* ((tnum (or tab-num + (dboard:commondat-curr-tab-num commondat))) + (curr-updaters (hash-table-ref/default (dboard:commondat-updaters commondat) tnum '()))) + (hash-table-set! (dboard:commondat-updaters commondat) + tnum + (cons updater curr-updaters)))) ;; data for each specific tab goes here ;; (defstruct dboard:tabdat allruns @@ -171,12 +194,10 @@ target test-patts tests tests-tree tot-runs -;; uidat - updater-for-runs ) (define (dboard:tabdat-target-string vec) (let ((targ (dboard:tabdat-target vec))) (if (list? targ)(string-intersperse targ "/") "no-target-specified"))) @@ -921,19 +942,18 @@ (sorted-testnames #f) (action "-run") (cmdln "") (runlogs (make-hash-table)) (key-listboxes #f) - ;; (updater-for-runs #f) (update-keyvals (lambda () (let ((targ (map (lambda (x) (iup:attribute x "VALUE")) (car (dashboard:update-target-selector key-listboxes)))) (curr-runname (dboard:tabdat-run-name tabdat))) (dboard:tabdat-target-set! tabdat targ) - (if (dboard:tabdat-updater-for-runs tabdat) - ((dboard:tabdat-updater-for-runs tabdat))) + ;; (if (dboard:tabdat-updater-for-runs tabdat) + ;; ((dboard:tabdat-updater-for-runs tabdat))) (if (or (not (equal? curr-runname (dboard:tabdat-run-name tabdat))) (equal? (dboard:tabdat-run-name tabdat) "")) (dboard:tabdat-run-name-set! tabdat curr-runname)) (dashboard:update-run-command tabdat)))) (tests-draw-state (make-hash-table)) ;; use for keeping state of the test canvas @@ -955,13 +975,13 @@ ;; Target, testpatt, state and status input boxes ;; (iup:vbox ;; Command to run, placed over the top of the canvas - (dcommon:command-action-selector tabdat) - (dcommon:command-runname-selector tabdat tabdat) - (dcommon:command-testname-selector tabdat tabdat update-keyvals key-listboxes)) + (dcommon:command-action-selector commondat tabdat) + (dcommon:command-runname-selector commondat tabdat) + (dcommon:command-testname-selector commondat tabdat update-keyvals key-listboxes)) (dcommon:command-tests-tasks-canvas tabdat test-records sorted-testnames tests-draw-state)) ;;(iup:frame ;; #:title "Logs" ;; To be replaced with tabs @@ -986,18 +1006,18 @@ (sorted-testnames #f) (action "-run") (cmdln "") (runlogs (make-hash-table)) (key-listboxes #f) - (updater-for-runs (dboard:tabdat-updater-for-runs tabdat)) + ;; (updater-for-runs (dboard:tabdat-updater-for-runs tabdat)) (update-keyvals (lambda () (let ((targ (map (lambda (x) (iup:attribute x "VALUE")) (car (dashboard:update-target-selector key-listboxes)))) (curr-runname (dboard:tabdat-run-name tabdat))) (dboard:tabdat-target-set! tabdat targ) - (if updater-for-runs (updater-for-runs)) + ;; (if updater-for-runs (updater-for-runs)) (if (or (not (equal? curr-runname (dboard:tabdat-run-name tabdat))) (equal? (dboard:tabdat-run-name tabdat) "")) (dboard:tabdat-run-name-set! tabdat curr-runname)) (dashboard:update-run-command tabdat)))) (tests-draw-state (make-hash-table)) ;; use for keeping state of the test canvas @@ -1018,12 +1038,12 @@ ;; Target, testpatt, state and status input boxes ;; (iup:vbox ;; Command to run, placed over the top of the canvas - (dcommon:command-action-selector tabdat) - (dcommon:command-runname-selector tabdat tabdat) + (dcommon:command-action-selector commondat tabdat) + (dcommon:command-runname-selector commondat tabdat) (dcommon:command-testname-selector tabdat tabdat update-keyvals key-listboxes)) (dcommon:command-tests-tasks-canvas tabdat test-records sorted-testnames tests-draw-state)) ;; (iup:frame @@ -1037,11 +1057,11 @@ ;;====================================================================== ;; S U M M A R Y ;;====================================================================== ;; ;; General info about the run(s) and megatest area -(define (dashboard:summary tabdat) +(define (dashboard:summary commondat tabdat) (let* ((rawconfig (read-config (conc *toppath* "/megatest.config") #f #f))) ;; changed to #f since I want #{} to be expanded by [system ...] to NOT be expanded. WAS: 'return-string))) (iup:vbox (iup:split #:value 500 (iup:frame @@ -1054,11 +1074,11 @@ (dcommon:keys-matrix rawconfig) (dcommon:general-info) ))) (iup:frame #:title "Server" - (dcommon:servers-table))) + (dcommon:servers-table commondat tabdat))) (iup:frame #:title "Megatest config settings" (iup:hbox (dcommon:section-matrix rawconfig "setup" "Varname" "Value") (iup:vbox @@ -1079,12 +1099,12 @@ (define (tree-path->run-id tabdat path) (if (not (null? path)) (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) path #f) #f)) -(define dashboard:update-run-summary-tab #f) -(define dashboard:update-new-view-tab #f) +;; (define dashboard:update-run-summary-tab #f) +;; (define dashboard:update-new-view-tab #f) (define (dboard:get-tests-dat tabdat run-id last-update) (let ((tdat (if run-id (rmt:get-tests-for-run run-id (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%") (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)) ;; '() @@ -1122,11 +1142,12 @@ (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) (if (number? run-id) (begin (dboard:tabdat-curr-run-id-set! tabdat run-id) - (dashboard:update-run-summary-tab)) + ;; (dashboard:update-run-summary-tab) + ) (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id))) ;; (print "path: " (tree:node->path obj id) " run-id: " run-id) ))) (cell-lookup (make-hash-table)) (run-matrix (iup:matrix @@ -1245,11 +1266,13 @@ (iup:attribute-set! run-matrix key name) (iup:attribute-set! run-matrix "FITTOTEXT" (conc "C" num)))))) col-indices) (if changed (iup:attribute-set! run-matrix "REDRAW" "ALL")))))) - (set! dashboard:update-run-summary-tab updater) + ;; REPLACE ME!!!! BUGGG!!!! + ;; (set! dashboard:update-run-summary-tab updater) + (dboard:commondat-add-updater commondat updater) (dboard:tabdat-runs-tree-set! tabdat tb) (iup:split tb run-matrix))) @@ -1267,11 +1290,12 @@ (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) (if (number? run-id) (begin (dboard:tabdat-curr-run-id-set! tabdat run-id) - (dashboard:update-new-view-tab)) + ;; (dashboard:update-new-view-tab) + ) (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id))) ;; (print "path: " (tree:node->path obj id) " run-id: " run-id) ))) (cell-lookup (make-hash-table)) (run-matrix (iup:matrix @@ -1388,12 +1412,11 @@ (set! changed #t) (iup:attribute-set! run-matrix key name) (iup:attribute-set! run-matrix "FITTOTEXT" (conc "C" num)))))) col-indices) (if changed (iup:attribute-set! run-matrix "REDRAW" "ALL")))))) - - (set! dashboard:update-new-view-tab updater) + (dboard:commondat-add-updater commondat updater) (dboard:tabdat-runs-tree-set! tabdat tb) (iup:split tb run-matrix))) @@ -1733,11 +1756,11 @@ ;; (data (dboard:tabdat-init (make-d:data))) (tabs (iup:tabs #:tabchangepos-cb (lambda (obj curr prev) (dboard:commondat-please-update-set! commondat #t) (dboard:commondat-curr-tab-num-set! commondat curr)) - (dashboard:summary runs-dat) + (dashboard:summary commondat runs-dat) runs-view (dashboard:one-run commondat onerun-dat) ;; (dashboard:new-view db data new-view-dat) (dashboard:run-controls commondat runcontrols-dat) (dashboard:run-times commondat runtimes-dat) @@ -1807,54 +1830,59 @@ (current-seconds)) ;; something went wrong - just print an error and return current-seconds (apply max (map (lambda (filen) (file-modification-time filen)) (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db")))))) -(define (dashboard:run-update x commondat) - (let* ((tabdat (dboard:common-get-tabdat commondat))) ;; uses curr-tab-num - (if tabdat ;; if there is no tabdat then likely we are in a test control panel, no update calls needed - (let* ((monitor-db-path (dboard:tabdat-monitor-db-path tabdat)) - (modtime (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!! - (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path)) - (file-modification-time monitor-db-path) - -1)) - (run-update-time (current-seconds)) - (uidat (dboard:commondat-uidat commondat)) - (recalc (dashboard:recalc modtime (dboard:commondat-please-update commondat) (dboard:tabdat-last-db-update tabdat)))) - (if (and (eq? (dboard:commondat-curr-tab-num commondat) 0) - (or (> monitor-modtime *last-monitor-update-time*) - (> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case - (begin - (set! *last-monitor-update-time* run-update-time) ;; monitor-modtime) - (if dashboard:update-servers-table (dashboard:update-servers-table)))) - (if recalc - (begin - (case (dboard:commondat-curr-tab-num commondat) - ((0) - (if dashboard:update-summary-tab (dashboard:update-summary-tab))) - ((1) ;; The runs table is active - (update-rundat tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat) - (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%") - ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%") - (let ((res '())) - (for-each (lambda (key) - (if (not (equal? key "runname")) - (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f))) - (if val (set! res (cons (list key val) res)))))) - (dboard:tabdat-dbkeys tabdat)) - res)) - (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat))) - ((2) - (dashboard:update-run-summary-tab)) - ((3) - (dashboard:update-new-view-tab)) - (else - (let ((updater (dboard:common-get-tabdat commondat))) - (if updater (updater))))) - (dboard:commondat-please-update-set! commondat #f) - (dboard:tabdat-last-db-update-set! tabdat modtime) - (set! *last-recalc-ended-time* (current-milliseconds)))))))) +(define (dashboard:monitor-changed? commondat tabdat) + (let* ((monitor-db-path (dboard:tabdat-monitor-db-path tabdat)) + (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path)) + (file-modification-time monitor-db-path) + -1))) + (if (and (eq? (dboard:commondat-curr-tab-num commondat) 0) + (or (> monitor-modtime *last-monitor-update-time*) + (> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case + (begin + (set! *last-monitor-update-time* run-update-time) ;; monitor-modtime) + #t) + #f))) + +(define (dashboard:database-changed? commondat tabdat) + (let* ((run-update-time (current-seconds)) + (modtime (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!! + (recalc (dashboard:recalc modtime (dboard:commondat-please-update commondat) (dboard:tabdat-last-db-update tabdat)))) + recalc)) + +;; (if dashboard:update-servers-table (dashboard:update-servers-table)))) + +(define (dashboard:summary-tab-updater commondat tab-num) + (if dashboard:update-summary-tab (dashboard:update-summary-tab))) + +(define (dashboard:runs-tab-updater commondat tab-num) + (let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))) + (update-rundat tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat) + (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%") + ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "item-name" "%") + (let ((res '())) + (for-each (lambda (key) + (if (not (equal? key "runname")) + (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f))) + (if val (set! res (cons (list key val) res)))))) + (dboard:tabdat-dbkeys tabdat)) + res)) + (let ((uidat (dboard:commondat-uidat commondat))) + (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat))) + (dboard:commondat-please-update-set! commondat #f) ;; NOTE BUG! THIS NEEDS TO BE MADE TAB SPECIFIC!!! + ;; (dboard:tabdat-last-db-update-set! tabdat modtime) + )) + +;; ((2) +;; (dashboard:update-run-summary-tab)) +;; ((3) +;; (dashboard:update-new-view-tab)) +;; (else +;; (dboard:common-run-curr-updater commondat))) +;; (set! *last-recalc-ended-time* (current-milliseconds)))))))) ;;====================================================================== ;; The heavy lifting starts here ;;====================================================================== @@ -1888,34 +1916,47 @@ (dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat)) ;; (dboard:tabdat-dblocal data) ;; (dboard:tabdat-numruns tabdat) ;; (dboard:tabdat-num-tests tabdat) ;; (dboard:tabdat-dbkeys tabdat) ;; runs-sum-dat new-view-dat)) + ;; legacy setup of updaters for summary tab and runs tab + ;; summary tab + (dboard:commondat-add-updater + commondat + (lambda () + (dashboard:summary-tab-updater commondat 0)) + tab-num: 0) + ;; runs tab + (dboard:commondat-add-updater + commondat + (lambda () + (dashboard:runs-tab-updater commondat 1)) + tab-num: 1) (iup:callback-set! *tim* "ACTION_CB" - (lambda (x) - (let ((update-is-running #f)) - (mutex-lock! (dboard:commondat-update-mutex commondat)) - (set! update-is-running (dboard:commondat-updating commondat)) - (if (not update-is-running) - (dboard:commondat-updating-set! commondat #t)) - (mutex-unlock! (dboard:commondat-update-mutex commondat)) - (if (not update-is-running) - (begin - (dashboard:run-update x commondat) - (mutex-lock! (dboard:commondat-update-mutex commondat)) - (dboard:commondat-updating-set! commondat #f) - (mutex-unlock! (dboard:commondat-update-mutex commondat))) - )) - 1)))) + (lambda (time-obj) + (let ((update-is-running #f)) + (mutex-lock! (dboard:commondat-update-mutex commondat)) + (set! update-is-running (dboard:commondat-updating commondat)) + (if (not update-is-running) + (dboard:commondat-updating-set! commondat #t)) + (mutex-unlock! (dboard:commondat-update-mutex commondat)) + (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update + (begin + (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat) + (mutex-lock! (dboard:commondat-update-mutex commondat)) + (dboard:commondat-updating-set! commondat #f) + (mutex-unlock! (dboard:commondat-update-mutex commondat))) + )) + 1)))) (let ((th1 (make-thread (lambda () (thread-sleep! 1) - (dboard:commondat-please-update-set! commondat #t) - (dashboard:run-update 1 commondat) + (dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab (dboard:commondat-please-update-set! commondat #t) + (dashboard:run-update commondat) ) "update buttons once")) (th2 (make-thread iup:main-loop "Main loop"))) (thread-start! th1) (thread-start! th2) (thread-join! th2)))) (main) Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -420,11 +420,11 @@ (iup:attribute-set! stats-matrix "WIDTHDEF" "40") (iup:vbox ;; (iup:label "Run statistics" #:expand "HORIZONTAL") stats-matrix))) -(define (dcommon:servers-table) +(define (dcommon:servers-table commondat tabdat) (let* ((tdbdat (tasks:open-db)) (colnum 0) (rownum 0) (servers-matrix (iup:matrix #:expand "YES" #:numcol 7 @@ -431,48 +431,49 @@ #:numcol-visible 7 #:numlin-visible 5 )) (colnames (list "Id" "MTver" "Pid" "Host" "Interface:OutPort" "RunTime" "State" "RunId")) (updater (lambda () - (let ((servers (tasks:get-all-servers (db:delay-if-busy tdbdat)))) - (iup:attribute-set! servers-matrix "NUMLIN" (length servers)) - ;; (set! colnum 0) - ;; (for-each (lambda (colname) - ;; ;; (print "colnum: " colnum " colname: " colname) - ;; (iup:attribute-set! servers-matrix (conc "0:" colnum) colname) - ;; (set! colnum (+ 1 colnum))) - ;; colnames) - (set! rownum 1) - (for-each - (lambda (server) - (set! colnum 0) - (let* ((vals (list (vector-ref server 0) ;; Id - (vector-ref server 9) ;; MT-Ver - (vector-ref server 1) ;; Pid - (vector-ref server 2) ;; Hostname - (conc (vector-ref server 3) ":" (vector-ref server 4)) ;; IP:Port - (seconds->hr-min-sec (- (current-seconds)(vector-ref server 6))) - ;; (vector-ref server 5) ;; Pubport - ;; (vector-ref server 10) ;; Last beat - ;; (vector-ref server 6) ;; Start time - ;; (vector-ref server 7) ;; Priority - ;; (vector-ref server 8) ;; State - (vector-ref server 8) ;; State - (vector-ref server 12) ;; RunId - ))) - (for-each (lambda (val) - (let* ((row-col (conc rownum ":" colnum)) - (curr-val (iup:attribute servers-matrix row-col))) - (if (not (equal? (conc val) curr-val)) - (begin - (iup:attribute-set! servers-matrix row-col val) - (iup:attribute-set! servers-matrix "FITTOTEXT" (conc "C" colnum)))) - (set! colnum (+ 1 colnum)))) - vals) - (set! rownum (+ rownum 1))) - (iup:attribute-set! servers-matrix "REDRAW" "ALL")) - servers))))) + (if (dashboard:monitor-changed? commondat tabdat) + (let ((servers (tasks:get-all-servers (db:delay-if-busy tdbdat)))) + (iup:attribute-set! servers-matrix "NUMLIN" (length servers)) + ;; (set! colnum 0) + ;; (for-each (lambda (colname) + ;; ;; (print "colnum: " colnum " colname: " colname) + ;; (iup:attribute-set! servers-matrix (conc "0:" colnum) colname) + ;; (set! colnum (+ 1 colnum))) + ;; colnames) + (set! rownum 1) + (for-each + (lambda (server) + (set! colnum 0) + (let* ((vals (list (vector-ref server 0) ;; Id + (vector-ref server 9) ;; MT-Ver + (vector-ref server 1) ;; Pid + (vector-ref server 2) ;; Hostname + (conc (vector-ref server 3) ":" (vector-ref server 4)) ;; IP:Port + (seconds->hr-min-sec (- (current-seconds)(vector-ref server 6))) + ;; (vector-ref server 5) ;; Pubport + ;; (vector-ref server 10) ;; Last beat + ;; (vector-ref server 6) ;; Start time + ;; (vector-ref server 7) ;; Priority + ;; (vector-ref server 8) ;; State + (vector-ref server 8) ;; State + (vector-ref server 12) ;; RunId + ))) + (for-each (lambda (val) + (let* ((row-col (conc rownum ":" colnum)) + (curr-val (iup:attribute servers-matrix row-col))) + (if (not (equal? (conc val) curr-val)) + (begin + (iup:attribute-set! servers-matrix row-col val) + (iup:attribute-set! servers-matrix "FITTOTEXT" (conc "C" colnum)))) + (set! colnum (+ 1 colnum)))) + vals) + (set! rownum (+ rownum 1))) + (iup:attribute-set! servers-matrix "REDRAW" "ALL")) + servers)))))) (set! colnum 0) (for-each (lambda (colname) (iup:attribute-set! servers-matrix (conc "0:" colnum) colname) (iup:attribute-set! servers-matrix "FITTOTEXT" (conc "C" colnum)) (set! colnum (+ colnum 1))) @@ -853,64 +854,65 @@ (let ((cmd (conc "xterm -geometry 180x20 -e \"" (iup:attribute (dboard:tabdat-command-tb data) "VALUE") ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &"))) (system cmd))))))) -(define (dcommon:command-action-selector data) +(define (dcommon:command-action-selector commondat tabdat) (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 '("run" "remove-runs" "set-state-status" "lock-runs" "unlock-runs")) (lb (iup:listbox #:expand "HORIZONTAL" #:dropdown "YES" #:action (lambda (obj val index lbstate) ;; (print obj " " val " " index " " lbstate) - (dboard:tabdat-command-set! data val) - (dashboard:update-run-command data)))) + (dboard:tabdat-command-set! tabdat val) + (dashboard:update-run-command tabdat)))) (default-cmd (car cmds-list))) (iuplistbox-fill-list lb cmds-list selected-item: default-cmd) - (dboard:tabdat-command-set! data default-cmd) + (dboard:tabdat-command-set! tabdat default-cmd) lb)))) -(define (dcommon:command-runname-selector alldat data) +(define (dcommon:command-runname-selector commondat tabdat) ;; alldat data) (iup:frame #:title "Runname" (let* ((default-run-name (seconds->work-week/day (current-seconds))) (tb (iup:textbox #:expand "HORIZONTAL" #:action (lambda (obj val txt) ;; (print "obj: " obj " val: " val " unk: " unk) - (dboard:tabdat-run-name-set! data txt) ;; (iup:attribute obj "VALUE")) - (dashboard:update-run-command data)) - #:value (or default-run-name (dboard:tabdat-run-name data)))) + (dboard:tabdat-run-name-set! tabdat txt) ;; (iup:attribute obj "VALUE")) + (dashboard:update-run-command tabdat)) + #:value (or default-run-name (dboard:tabdat-run-name tabdat)))) (lb (iup:listbox #:expand "HORIZONTAL" #:dropdown "YES" #:action (lambda (obj val index lbstate) (if (not (equal? val "")) (begin (iup:attribute-set! tb "VALUE" val) - (dboard:tabdat-run-name-set! data val) - (dashboard:update-run-command data)))))) + (dboard:tabdat-run-name-set! tabdat val) + (dashboard:update-run-command tabdat)))))) (refresh-runs-list (lambda () - (let* ((target (dboard:tabdat-target-string data)) - (runs-for-targ (rmt:get-runs-by-patt (dboard:tabdat-keys alldat) "%" target #f #f #f)) + (let* ((target (dboard:tabdat-target-string tabdat)) + (runs-for-targ (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" target #f #f #f)) (runs-header (vector-ref runs-for-targ 0)) (runs-dat (vector-ref runs-for-targ 1)) (run-names (cons default-run-name (map (lambda (x) (db:get-value-by-header x runs-header "runname")) runs-dat)))) ;; (iup:attribute-set! lb "REMOVEITEM" "ALL") (iuplistbox-fill-list lb run-names selected-item: default-run-name))))) - (dboard:tabdat-updater-for-runs-set! data refresh-runs-list) + ;; (dboard:tabdat-updater-for-runs-set! tabdat refresh-runs-list) + (dboard:commondat-add-updater commondat refresh-runs-list) (refresh-runs-list) - (dboard:tabdat-run-name-set! data default-run-name) + (dboard:tabdat-run-name-set! tabdat default-run-name) (iup:hbox tb lb)))) -(define (dcommon:command-testname-selector alldat data update-keyvals key-listboxes) +(define (dcommon:command-testname-selector commondat tabdat update-keyvals key-listboxes) (iup:frame #:title "SELECTORS" (iup:vbox ;; Text box for test patterns (iup:frame @@ -917,13 +919,13 @@ #:title "Test patterns (one per line)" (let ((tb (iup:textbox #:action (lambda (val a b) (dboard:tabdat-test-patts-set!-use data (dboard:lines->test-patt b)) - (dashboard:update-run-command data)) + (dashboard:update-run-command tabdat)) #:value (dboard:test-patt->lines - (dboard:tabdat-test-patts-use data)) + (dboard:tabdat-test-patts-use tabdat)) #:expand "YES" #:size "x50" #:multiline "YES"))) (set! test-patterns-textbox tb) tb)) @@ -942,20 +944,20 @@ #:title "States" (dashboard:text-list-toggle-box ;; Move these definitions to common and find the other useages and replace! (map cadr *common:std-states*) ;; '("COMPLETED" "RUNNING" "STUCK" "INCOMPLETE" "LAUNCHED" "REMOTEHOSTSTART" "KILLED") (lambda (all) - (dboard:tabdat-states-set! data all) - (dashboard:update-run-command data)))) + (dboard:tabdat-states-set! tabdat all) + (dashboard:update-run-command tabdat)))) ;; Text box for STATES (iup:frame #:title "Statuses" (dashboard:text-list-toggle-box (map cadr *common:std-statuses*) ;; '("PASS" "FAIL" "n/a" "CHECK" "WAIVED" "SKIP" "DELETED" "STUCK/DEAD") (lambda (all) - (dboard:tabdat-statuses-set! data all) - (dashboard:update-run-command data)))))))) + (dboard:tabdat-statuses-set! tabdat all) + (dashboard:update-run-command tabdat)))))))) (define (dcommon:command-tests-tasks-canvas data test-records sorted-testnames tests-draw-state) (iup:frame #:title "Tests and Tasks" (let* ((updater #f)