Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -119,11 +119,11 @@ ;; T E S T S ;;====================================================================== ;; Test browser -(define (tree-browser data adat window-id) +(define (dashboard:tree-browser data adat window-id) ;; (iup:split (let* ((tb (iup:treebox #:selection-cb (lambda (obj id state) ;; (print "obj: " obj ", id: " id ", state: " state) @@ -214,11 +214,11 @@ ;; R U N C O N T R O L ;;====================================================================== ;; General displayer ;; -(define (area-display data adat window-id) +(define (dashboard:area-display data adat window-id) (let* ((view-matrix (iup:matrix #:expand "YES" ;; #:fittosize "YES" #:scrollbar "YES" #:numcol 100 @@ -270,11 +270,11 @@ ;; D A S H B O A R D ;;====================================================================== ;; Main Panel ;; -(define (main-panel data window-id) +(define (dashboard:main-panel data window-id) (iup:dialog #:title "Megatest Control Panel" #:menu (dcommon:main-menu data) #:shrink "YES" (iup:vbox @@ -281,38 +281,44 @@ (let* ((area-names (hash-table-keys (dboard:data-cfgdat data))) (area-panels (map (lambda (aname) (let* ((apath (configf:lookup (dboard:data-cfgdat data) aname "path")) ;; (hash-table-ref (dboard:data-cfgdat data) area-name)) ;; (hash-table-ref (dboard:data-cfgdat data) aname)) (area-dat (dashboard:init-area data aname apath)) - (tb (tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data) - (ad (area-display data area-dat window-id)) + (tb (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data) + (ad (dashboard:area-display data area-dat window-id)) (areas (dboard:data-areas data)) - (dboard-dat (make-dboard:area + (dboard-dat (make-dboard:tab #f ;; tree #f ;; matrix area-dat ;; #f ;; view path 'default ;; view type - #f ;; matrix #f ;; controls #f ;; cached data #f ;; filters #f ;; the run-id (make-hash-table) ;; run-id -> test-id, for current test id "" ))) (hash-table-set! (dboard:data-areas data) aname dboard-dat) - (dboard:area-tree-set! dboard-dat tb) - (dboard:area-matrix-set! dboard-dat ad) + (dboard:tab-tree-set! dboard-dat tb) + (dboard:tab-matrix-set! dboard-dat ad) (iup:split #:value 200 tb ad))) area-names)) - (tabtop (apply iup:tabs area-panels))) + (tabtop (apply iup:tabs + #:tabchangepos-cb (lambda (obj curr prev) + (dboard:data-current-tab-id-set! data curr) + (dboard:data-update-needed-set! data #t) + (print "Tab is: " curr ", prev was " prev)) + area-panels)) + (tab-ids (dboard:data-tab-ids data))) (let loop ((index 0) (hed (car area-names)) (tal (cdr area-names))) + (hash-table-set! tab-ids index hed) (debug:print 0 "Adding area " hed " with index " index " to dashboard") (iup:attribute-set! tabtop (conc "TABTITLE" index) hed) (if (not (null? tal)) (loop (+ index 1)(car tal)(cdr tal)))) tabtop)))) @@ -325,11 +331,11 @@ ;; (states '()) ;; (statuses '()) (nextmintime (current-milliseconds))) (dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data))) ;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application - (iup:show (main-panel data (dboard:data-current-window-id data))) + (iup:show (dashboard:main-panel data (dboard:data-current-window-id data))) ;; Yes, running iup:show will pop up a new panel ;; (iup:show (main-panel my-window-id)) (iup:callback-set! *tim* "ACTION_CB" (lambda (x) @@ -352,9 +358,12 @@ (cfname (conc (getenv "HOME") "/.megatest/" groupn ".dat")) (cfgdat (if (file-exists? cfname)(read-config cfname (make-hash-table) #t))) (data (make-dboard:data cfgdat ;; this is the data from ~/.megatest for the selected group (make-hash-table) ;; areaname -> area-rec - 0 + 0 ;; current window id + 0 ;; current tab id + #f ;; redraw needed for current tab id + (make-hash-table) ;; tab-id -> areaname ))) (newdashboard data window-id) (iup:main-loop)) Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -38,22 +38,24 @@ ;; all areas tracked. ;; (define-record dboard:data - cfgdat ;; data from ~/.megatest/.dat - areas ;; hash of areaname -> area-rec - current-window-id + cfgdat ;; data from ~/.megatest/.dat + areas ;; hash of areaname -> area-rec + current-window-id ;; + current-tab-id ;; + update-needed ;; flag to indicate that the tab pointed to by current tab id needs refreshing immediately + tab-ids ;; hash of tab-id -> areaname ) -(define-record dboard:area +(define-record dboard:tab tree - matrix + matrix ;; the spreadsheet area-dat ;; the one-structure (one day dbstruct will be put in here) view-path ;; //... view-type ;; standard, etc. - matrix ;; the spreadsheet controls ;; the controls data ;; all the data kept in sync with db filters ;; user filters run-id ;; the current run-id test-ids ;; the current test id hash, run-id => test-id @@ -147,60 +149,69 @@ ;; 2. Update synchash to understand "get-runs", "get-tests" etc. ;; 3. Add extraction of filters to synchash calls ;; ;; Mode is 'full or 'incremental for full refresh or incremental refresh (define (dcommon:run-update data) - (thread-sleep! 0.25)) - -;; (let* (;; count and offset => #f so not used -;; ;; the synchash calls modify the "data" hash -;; (get-runs-sig (conc (client:get-signature) " get-runs")) -;; (get-tests-sig (conc (client:get-signature) " get-tests")) -;; (get-details-sig (conc (client:get-signature) " get-test-details")) -;; -;; ;; test-ids to get and display are indexed on window-id in curr-test-ids hash -;; (test-ids (hash-table-values (dboard:data-get-curr-test-ids *data*))) -;; ;; run-id is #f in next line to send the query to server 0 -;; (run-changes (synchash:client-get *area-dat* 'db:get-runs get-runs-sig (length keypatts) data #f runname #f #f keypatts)) -;; (tests-detail-changes (if (not (null? test-ids)) -;; (synchash:client-get *area-dat* 'db:get-test-info-by-ids get-details-sig 0 data #f test-ids) -;; '())) -;; -;; ;; Now can calculate the run-ids -;; (run-hash (hash-table-ref/default data get-runs-sig #f)) -;; (run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '())) -;; -;; (all-test-changes (let ((res (make-hash-table))) -;; (for-each (lambda (run-id) -;; (if (> run-id 0) -;; (hash-table-set! res run-id (synchash:client-get *area-dat* 'db:get-tests-for-run-mindata get-tests-sig 0 data run-id 1 testpatt states statuses #f)))) -;; run-ids) -;; res)) -;; (runs-hash (hash-table-ref/default data get-runs-sig #f)) -;; (header (hash-table-ref/default runs-hash "header" #f)) -;; (run-ids (sort (filter number? (hash-table-keys runs-hash)) -;; (lambda (a b) -;; (let* ((record-a (hash-table-ref runs-hash a)) -;; (record-b (hash-table-ref runs-hash b)) -;; (time-a (db:get-value-by-header record-a header "event_time")) -;; (time-b (db:get-value-by-header record-b header "event_time"))) -;; (> time-a time-b))) -;; )) -;; (runid-to-col (hash-table-ref *cachedata* "runid-to-col")) -;; (testname-to-row (hash-table-ref *cachedata* "testname-to-row")) -;; (colnum 1) -;; (rownum 0)) ;; rownum = 0 is the header -;; ;; (debug:print 0 "test-ids " test-ids ", tests-detail-changes " tests-detail-changes) -;; -;; ;; tests related stuff -;; ;; (all-testnames (delete-duplicates (map db:test-get-testname test-changes)))) -;; -;; ;; Given a run-id and testname/item_path calculate a cell R:C -;; -;; ;; NOTE: Also build the test tree browser and look up table -;; ;; -;; ;; Each run is unique on its keys and runname or run-id, store in hash on colnum + (let* ((current-tab-id (dboard:data-current-tab-id data)) + (area-name (hash-table-ref (dboard:data-tab-ids data) current-tab-id)) + (tab-dat (hash-table-ref (dboard:data-areas data) area-name)) + (matrix (dboard:tab-matrix tab-dat)) + (tree (dboard:tab-tree tab-dat)) + (area-dat (dboard:tab-area-dat tab-dat)) + (runpatt "%")) ;; get from dboard:tab-filters + (if (dboard:data-update-needed data) + (let* (;; count and offset => #f so not used + ;; the synchash calls modify the "data" hash + ;; (get-runs-sig (conc (client:get-signature) " get-runs")) + ;; (get-tests-sig (conc (client:get-signature) " get-tests")) + ;; (get-details-sig (conc (client:get-signature) " get-test-details")) + + ;; test-ids to get and display are indexed on window-id in curr-test-ids hash + ;; (test-ids (hash-table-values (dboard:data-get-curr-test-ids *data*))) + ;; run-id is #f in next line to send the query to server 0 + ;; (run-changes (synchash:client-get *area-dat* 'db:get-runs get-runs-sig (length keypatts) data #f runname #f #f keypatts)) + ;; (tests-detail-changes (if (not (null? test-ids)) + ;; (synchash:client-get *area-dat* 'db:get-test-info-by-ids get-details-sig 0 data #f test-ids) + ;; '())) + + ;; Now can calculate the run-ids + ;; (run-hash (hash-table-ref/default data get-runs-sig #f)) + ;; (run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '())) + (launch:setup-for-run area-dat) + (all-runs-dat (rmt:get-runs runpatt #f #f '() area-dat))) + (print "all-runs-dat: " all-runs-dat))))) + + ;; (all-test-changes (let ((res (make-hash-table))) + ;; (for-each (lambda (run-id) + ;; (if (> run-id 0) + ;; (hash-table-set! res run-id (synchash:client-get *area-dat* 'db:get-tests-for-run-mindata get-tests-sig 0 data run-id 1 testpatt states statuses #f)))) + ;; run-ids) + ;; res)) + ;; (runs-hash (hash-table-ref/default data get-runs-sig #f)) + ;; (header (hash-table-ref/default runs-hash "header" #f)) + ;; (run-ids (sort (filter number? (hash-table-keys runs-hash)) + ;; (lambda (a b) + ;; (let* ((record-a (hash-table-ref runs-hash a)) + ;; (record-b (hash-table-ref runs-hash b)) + ;; (time-a (db:get-value-by-header record-a header "event_time")) + ;; (time-b (db:get-value-by-header record-b header "event_time"))) + ;; (> time-a time-b))) + ;; )) + ;; (runid-to-col (hash-table-ref *cachedata* "runid-to-col")) + ;; (testname-to-row (hash-table-ref *cachedata* "testname-to-row")) + ;; (colnum 1) + ;; (rownum 0)) ;; rownum = 0 is the header + ;; ;; (debug:print 0 "test-ids " test-ids ", tests-detail-changes " tests-detail-changes) + ;; + ;; ;; tests related stuff + ;; ;; (all-testnames (delete-duplicates (map db:test-get-testname test-changes)))) + ;; + ;; ;; Given a run-id and testname/item_path calculate a cell R:C + ;; + ;; ;; NOTE: Also build the test tree browser and look up table + ;; ;; + ;; ;; Each run is unique on its keys and runname or run-id, store in hash on colnum ;; (for-each (lambda (run-id) ;; (let* ((run-record (hash-table-ref/default runs-hash run-id #f)) ;; (key-vals (map (lambda (key)(db:get-value-by-header run-record header key)) ;; keys)) ;; (run-name (db:get-value-by-header run-record header "runname")) Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -537,13 +537,10 @@ (rmt:send-receive 'delete-run run-id (list run-id) area-dat)) (define (rmt:delete-old-deleted-test-records area-dat) (rmt:send-receive 'delete-old-deleted-test-records #f '() area-dat)) -(define (rmt:get-runs runpatt count offset keypatts area-dat) - (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts) area-dat)) - (define (rmt:get-runs runpatt count offset keypatts area-dat) (rmt:send-receive 'get-runs #f (list runpatt count offset keypatts) area-dat)) (define (rmt:get-all-run-ids area-dat) (rmt:send-receive 'get-all-run-ids #f '() area-dat))