Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -24,10 +24,11 @@ (declare (uses db)) (declare (uses server)) (declare (uses synchash)) (declare (uses dcommon)) (declare (uses tree)) +(declare (uses configf)) (include "common_records.scm") (include "db_records.scm") (include "key_records.scm") @@ -36,11 +37,11 @@ version " megatest-version " license GPL, Copyright (C) Matt Welland 2011 Usage: dashboard [options] -h : this help - -server host:port : connect to host:port instead of db access + -group groupname : display this group of areas -test testid : control test identified by testid -guimonitor : control panel for runs Misc -rows N : set number of rows @@ -47,19 +48,14 @@ ")) ;; process args (define remargs (args:get-args (argv) - (list "-rows" - "-run" - "-test" + (list "-group" ;; display this group of areas "-debug" - "-host" ) (list "-h" - "-guimonitor" - "-main" "-v" "-q" ) args:arg-hash 0)) @@ -96,33 +92,10 @@ (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc"))) (if (file-exists? debugcontrolf) (load debugcontrolf))) (define *runremote* #f) -;; (define *data* (make-vector 25 #f)) -;; -;; (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]) -;; (dboard:data-set-path-test-ids! *data* (make-hash-table)) -;; -;; ;; Look up run-ids by ?? -;; (dboard:data-set-path-run-ids! *data* (make-hash-table)) -;; -;; (dboard:data-set-updaters! *data* (make-hash-table)) -;; -;; (define *other* (make-hash-table)) -;; (define *dbdir* (db:dbfile-path #f *area-dat*)) -;; (define *dbstruct-local* (make-dbr:dbstruct path: *dbdir* -;; local: #t)) -;; (define *db-file-path* (db:dbfile-path 0 *area-dat*)) -;; -;; ;; HACK ALERT: this is a hack, please fix. -;; (define *read-only* (not (file-read-access? *db-file-path*))) (debug:setup) (define *tim* (iup:timer)) (define *ord* #f) @@ -468,28 +441,32 @@ (iup:attribute-set! tabs "TABTITLE0" "Test Steps") (iup:attribute-set! tabs "TABTITLE1" "Test Data") tabs))))) ;; Test browser -(define (tests window-id) - (iup:split - (let* ((tb (iup:treebox - #:selection-cb - (lambda (obj id state) - ;; (print "obj: " obj ", id: " id ", state: " state) - (let* ((run-path (tree:node->path obj id)) - (test-id (tree-path->test-id (cdr run-path)))) - (if test-id - (hash-table-set! (dboard:data-get-curr-test-ids *data*) - window-id test-id)) - (print "path: " (tree:node->path obj id) " test-id: " test-id)))))) - (iup:attribute-set! tb "VALUE" "0") - (iup:attribute-set! tb "NAME" "Runs") - ;;(iup:attribute-set! tb "ADDEXPANDED" "NO") - (dboard:data-set-tests-tree! *data* tb) - tb) - (test-panel window-id))) +(define (tree-browser data window-id) + ;; (iup:split + (let* ((tb (iup:treebox + #:selection-cb + (lambda (obj id state) + ;; (print "obj: " obj ", id: " id ", state: " state) + (let* ((tree-path (tree:node->path obj id)) + (area (car tree-path)) + (area-path (cdr tree-path))) + #f + ;; (test-id (tree-path->test-id (cdr run-path)))) + ;; (if test-id + ;; (hash-table-set! (dboard:data-get-curr-test-ids *data*) + ;; window-id test-id)) + ;; (print "path: " (tree:node->path obj id) " test-id: " test-id)))))) + ))))) + ;; (iup:attribute-set! tb "VALUE" "0") + ;; (iup:attribute-set! tb "NAME" "Runs") + ;; (iup:attribute-set! tb "ADDEXPANDED" "NO") + ;; (dboard:data-set-tests-tree! *data* tb) + tb)) +;; (test-panel window-id))) ;; The function to update the fields in the test view panel (define (test-update window-id testdat run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix steps-matrix data-matrix) ;; get test-id ;; then get test record @@ -575,33 +552,33 @@ ;;====================================================================== ;; R U N C O N T R O L ;;====================================================================== -;; Overall runs browser +;; General displayer ;; -(define (runs window-id) - (let* ((runs-matrix (iup:matrix +(define (area-display data window-id) + (let* ((view-matrix (iup:matrix #:expand "YES" ;; #:fittosize "YES" #:scrollbar "YES" #:numcol 100 #:numlin 100 - #:numcol-visible 7 - #:numlin-visible 7 + #:numcol-visible 3 + #:numlin-visible 3 #:click-cb (lambda (obj lin col status) (print "obj: " obj " lin: " lin " col: " col " status: " status))))) - (iup:attribute-set! runs-matrix "RESIZEMATRIX" "YES") - (iup:attribute-set! runs-matrix "WIDTH0" "100") + (iup:attribute-set! view-matrix "RESIZEMATRIX" "YES") + (iup:attribute-set! view-matrix "WIDTH0" "100") - (dboard:data-set-runs-matrix! *data* runs-matrix) + ;; (dboard:data-set-runs-matrix! *data* runs-matrix) (iup:hbox (iup:frame #:title "Runs browser" (iup:vbox - runs-matrix))))) + view-matrix))))) ;; Browse and control a single run ;; (define (runcontrol window-id) (iup:hbox)) @@ -608,62 +585,75 @@ ;;====================================================================== ;; D A S H B O A R D ;;====================================================================== +(define (make-area-panel data area-name window-id) + (iup:split + #:value 200 + (tree-browser data window-id) ;; (dboard:areas-tree-browser data) + (area-display data window-id))) + ;; Main Panel -(define (main-panel window-id) +(define (main-panel data window-id) (iup:dialog #:title "Megatest Control Panel" - #:menu (dcommon:main-menu *other*) + #:menu (dcommon:main-menu data) #:shrink "YES" - (let ((tabtop (iup:tabs - (runs window-id ) - (tests window-id ) - (runcontrol window-id ) - (mtest window-id *area-dat*) - (rconfig window-id ) - ))) - (iup:attribute-set! tabtop "TABTITLE0" "Runs") - (iup:attribute-set! tabtop "TABTITLE1" "Tests") - (iup:attribute-set! tabtop "TABTITLE2" "Run Control") - (iup:attribute-set! tabtop "TABTITLE3" "megatest.config") - (iup:attribute-set! tabtop "TABTITLE4" "runconfigs.config") - tabtop))) + (iup:vbox + (let* ((area-names (hash-table-keys (dboard:areas-area-groups data))) + (areas (map (lambda (aname) + (make-area-panel data aname window-id)) + area-names)) + (tabtop (apply iup:tabs areas))) + (let loop ((index 0) + (hed (car area-names)) + (tal (cdr area-names))) + (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)))) (define *current-window-id* 0) -(define (newdashboard data) - (let* ((keys (db:get-keys *dbstruct-local* *area-dat*)) - (runname "%") - (testpatt "%") - (keypatts (map (lambda (k)(list k "%")) keys)) - (states '()) - (statuses '()) - (nextmintime (current-milliseconds)) - (my-window-id *current-window-id*)) - (set! *current-window-id* (+ 1 *current-window-id*)) - (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application - (iup:show (main-panel my-window-id)) +(define (newdashboard data window-id) + (let* (;; (keys (db:get-keys *dbstruct-local* *area-dat*)) + ;; (runname "%") + ;; (testpatt "%") + ;; (keypatts (map (lambda (k)(list k "%")) keys)) + ;; (states '()) + ;; (statuses '()) + (nextmintime (current-milliseconds))) + (dboard:areas-current-window-id-set! data (+ 1 (dboard:areas-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:areas-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) - ;; Want to dedicate no more than 50% of the time to this so skip if - ;; 2x delta time has not passed since last query - ;; (if (< nextmintime (current-milliseconds)) - ;; (let* ((starttime (current-milliseconds)) - ;; (changes '()) ;; (dcommon:run-update keys data runname keypatts testpatt states statuses 'full my-window-id)) - ;; (endtime (current-milliseconds))) - ;; (set! nextmintime (+ endtime (* 2 (- endtime starttime)))) - ;; ;; (debug:print 11 "CHANGE(S): " (car changes) "...") - ;; ) - ;; (debug:print-info 11 "Server overloaded")))))) - ;; pretend to do work .... - (thread-sleep! 0.1) - )))) -;;; main + (let ((starttime (current-milliseconds))) + ;; Want to dedicate no more than 50% of the time to this so skip if + ;; 2x delta time has not passed since last query + ;; (if (< (inexact->exact nextmintime)(inexact->exact starttime)) + ;; (let* ((changes (dcommon:run-update data)) ;;keys data runname keypatts testpatt states statuses 'full my-window-id)) + ;; (endtime (current-milliseconds))) + ;; (set! nextmintime (+ endtime (* 2.0 (- endtime starttime)))) + ;; ;; (debug:print 11 "CHANGE(S): " (car changes) "...") + ;; ) + ;; (debug:print-info 11 "Server overloaded"))))))) + (dcommon:run-update data)))))) + +;;; main. Theoretically could have multiple windows (each with a group of tags, thus window-id ;;; -(let ((data (make-hash-table))) ;; data will have "areaname" => "area record" entries - (newdashboard data) +(let* ((window-id 0) + (groupn (or (args:get-arg "-group") "default")) + (cfname (conc (getenv "HOME") "/.megatest/" groupn ".dat")) + (cfgdat (if (file-exists? cfname)(read-config cfname (make-hash-table) #t))) + (data (make-dboard:areas + cfgdat + 0 + #f))) + ;; (dboard:areas-tree-browser-set! data (tree-browser data window-id)) ;; data will have "areaname" => "area record" entries + (newdashboard data window-id) (iup:main-loop)) Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -38,11 +38,13 @@ ;; all areas tracked. ;; (define-record dboard:areas - areas ;; hash of name -> area + area-groups ;; hash of group -> areanames -> areapaths + current-window-id + tree-browser ) (define-record dboard:area read-only ;; #t => can't write dbstruct ;; database connector @@ -150,159 +152,161 @@ ;; 1. Make "data" hash-table hierarchial store of all displayed data ;; 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 keys data runname keypatts testpatt states statuses mode window-id) - (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 - (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")) - (col-name (conc (string-intersperse key-vals "\n") "\n" run-name)) - (run-path (append key-vals (list run-name)))) - (hash-table-set! (dboard:data-get-run-keys *data*) run-id run-path) - (iup:attribute-set! (dboard:data-get-runs-matrix *data*) - (conc rownum ":" colnum) col-name) - (hash-table-set! runid-to-col run-id (list colnum run-record)) - ;; Here we update the tests treebox and tree keys - (tree:add-node (dboard:data-get-tests-tree *data*) "Runs" (append key-vals (list run-name)) - userdata: (conc "run-id: " run-id)) - (set! colnum (+ colnum 1)))) - run-ids) - - ;; Scan all tests to be displayed and organise all the test names, respecting what is in the hash table - ;; Do this analysis in the order of the run-ids, the most recent run wins - (for-each (lambda (run-id) - (let* ((run-path (hash-table-ref (dboard:data-get-run-keys *data*) run-id)) - (test-changes (hash-table-ref all-test-changes run-id)) - (new-test-dat (car test-changes)) - (removed-tests (cadr test-changes)) - (tests (sort (map cadr (filter (lambda (testrec) - (eq? run-id (db:mintest-get-run_id (cadr testrec)))) - new-test-dat)) - (lambda (a b) - (let ((time-a (db:mintest-get-event_time a)) - (time-b (db:mintest-get-event_time b))) - (> time-a time-b))))) - ;; test-changes is a list of (( id record ) ... ) - ;; Get list of test names sorted by time, remove tests - (test-names (delete-duplicates (map (lambda (t) - (let ((i (db:mintest-get-item_path t)) - (n (db:mintest-get-testname t))) - (if (string=? i "") - (conc " " i) - n))) - tests))) - (colnum (car (hash-table-ref runid-to-col run-id)))) - ;; for each test name get the slot if it exists and fill in the cell - ;; or take the next slot and fill in the cell, deal with items in the - ;; run view panel? The run view panel can have a tree selector for - ;; browsing the tests/items - - ;; SWITCH THIS TO USING CHANGED TESTS ONLY - (for-each (lambda (test) - (let* ((test-id (db:mintest-get-id test)) - (state (db:mintest-get-state test)) - (status (db:mintest-get-status test)) - (testname (db:mintest-get-testname test)) - (itempath (db:mintest-get-item_path test)) - (fullname (conc testname "/" itempath)) - (dispname (if (string=? itempath "") testname (conc " " itempath))) - (rownum (hash-table-ref/default testname-to-row fullname #f)) - (test-path (append run-path (if (equal? itempath "") - (list testname) - (list testname itempath)))) - (tb (dboard:data-get-tests-tree *data*))) - (print "INFONOTE: run-path: " run-path) - (tree:add-node (dboard:data-get-tests-tree *data*) "Runs" - test-path - userdata: (conc "test-id: " test-id)) - (let ((node-num (tree:find-node tb (cons "Runs" test-path))) - (color (car (gutils:get-color-for-state-status state status)))) - (debug:print 0 "node-num: " node-num ", color: " color) - (iup:attribute-set! tb (conc "COLOR" node-num) color)) - (hash-table-set! (dboard:data-get-path-test-ids *data*) test-path test-id) - (if (not rownum) - (let ((rownums (hash-table-values testname-to-row))) - (set! rownum (if (null? rownums) - 1 - (+ 1 (apply max rownums)))) - (hash-table-set! testname-to-row fullname rownum) - ;; create the label - (iup:attribute-set! (dboard:data-get-runs-matrix *data*) - (conc rownum ":" 0) dispname) - )) - ;; set the cell text and color - ;; (debug:print 2 "rownum:colnum=" rownum ":" colnum ", state=" status) - (iup:attribute-set! (dboard:data-get-runs-matrix *data*) - (conc rownum ":" colnum) - (if (member state '("ARCHIVED" "COMPLETED")) - status - state)) - (iup:attribute-set! (dboard:data-get-runs-matrix *data*) - (conc "BGCOLOR" rownum ":" colnum) - (car (gutils:get-color-for-state-status state status))) - )) - tests))) - run-ids) - - (let ((updater (hash-table-ref/default (dboard:data-get-updaters *data*) window-id #f))) - (if updater (updater (hash-table-ref/default data get-details-sig #f)))) - - (iup:attribute-set! (dboard:data-get-runs-matrix *data*) "REDRAW" "ALL") - ;; (debug:print 2 "run-changes: " run-changes) - ;; (debug:print 2 "test-changes: " test-changes) - (list run-changes all-test-changes))) +(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 +;; (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")) +;; (col-name (conc (string-intersperse key-vals "\n") "\n" run-name)) +;; (run-path (append key-vals (list run-name)))) +;; (hash-table-set! (dboard:data-get-run-keys *data*) run-id run-path) +;; (iup:attribute-set! (dboard:data-get-runs-matrix *data*) +;; (conc rownum ":" colnum) col-name) +;; (hash-table-set! runid-to-col run-id (list colnum run-record)) +;; ;; Here we update the tests treebox and tree keys +;; (tree:add-node (dboard:data-get-tests-tree *data*) "Runs" (append key-vals (list run-name)) +;; userdata: (conc "run-id: " run-id)) +;; (set! colnum (+ colnum 1)))) +;; run-ids) +;; +;; ;; Scan all tests to be displayed and organise all the test names, respecting what is in the hash table +;; ;; Do this analysis in the order of the run-ids, the most recent run wins +;; (for-each (lambda (run-id) +;; (let* ((run-path (hash-table-ref (dboard:data-get-run-keys *data*) run-id)) +;; (test-changes (hash-table-ref all-test-changes run-id)) +;; (new-test-dat (car test-changes)) +;; (removed-tests (cadr test-changes)) +;; (tests (sort (map cadr (filter (lambda (testrec) +;; (eq? run-id (db:mintest-get-run_id (cadr testrec)))) +;; new-test-dat)) +;; (lambda (a b) +;; (let ((time-a (db:mintest-get-event_time a)) +;; (time-b (db:mintest-get-event_time b))) +;; (> time-a time-b))))) +;; ;; test-changes is a list of (( id record ) ... ) +;; ;; Get list of test names sorted by time, remove tests +;; (test-names (delete-duplicates (map (lambda (t) +;; (let ((i (db:mintest-get-item_path t)) +;; (n (db:mintest-get-testname t))) +;; (if (string=? i "") +;; (conc " " i) +;; n))) +;; tests))) +;; (colnum (car (hash-table-ref runid-to-col run-id)))) +;; ;; for each test name get the slot if it exists and fill in the cell +;; ;; or take the next slot and fill in the cell, deal with items in the +;; ;; run view panel? The run view panel can have a tree selector for +;; ;; browsing the tests/items +;; +;; ;; SWITCH THIS TO USING CHANGED TESTS ONLY +;; (for-each (lambda (test) +;; (let* ((test-id (db:mintest-get-id test)) +;; (state (db:mintest-get-state test)) +;; (status (db:mintest-get-status test)) +;; (testname (db:mintest-get-testname test)) +;; (itempath (db:mintest-get-item_path test)) +;; (fullname (conc testname "/" itempath)) +;; (dispname (if (string=? itempath "") testname (conc " " itempath))) +;; (rownum (hash-table-ref/default testname-to-row fullname #f)) +;; (test-path (append run-path (if (equal? itempath "") +;; (list testname) +;; (list testname itempath)))) +;; (tb (dboard:data-get-tests-tree *data*))) +;; (print "INFONOTE: run-path: " run-path) +;; (tree:add-node (dboard:data-get-tests-tree *data*) "Runs" +;; test-path +;; userdata: (conc "test-id: " test-id)) +;; (let ((node-num (tree:find-node tb (cons "Runs" test-path))) +;; (color (car (gutils:get-color-for-state-status state status)))) +;; (debug:print 0 "node-num: " node-num ", color: " color) +;; (iup:attribute-set! tb (conc "COLOR" node-num) color)) +;; (hash-table-set! (dboard:data-get-path-test-ids *data*) test-path test-id) +;; (if (not rownum) +;; (let ((rownums (hash-table-values testname-to-row))) +;; (set! rownum (if (null? rownums) +;; 1 +;; (+ 1 (apply max rownums)))) +;; (hash-table-set! testname-to-row fullname rownum) +;; ;; create the label +;; (iup:attribute-set! (dboard:data-get-runs-matrix *data*) +;; (conc rownum ":" 0) dispname) +;; )) +;; ;; set the cell text and color +;; ;; (debug:print 2 "rownum:colnum=" rownum ":" colnum ", state=" status) +;; (iup:attribute-set! (dboard:data-get-runs-matrix *data*) +;; (conc rownum ":" colnum) +;; (if (member state '("ARCHIVED" "COMPLETED")) +;; status +;; state)) +;; (iup:attribute-set! (dboard:data-get-runs-matrix *data*) +;; (conc "BGCOLOR" rownum ":" colnum) +;; (car (gutils:get-color-for-state-status state status))) +;; )) +;; tests))) +;; run-ids) +;; +;; (let ((updater (hash-table-ref/default (dboard:data-get-updaters *data*) window-id #f))) +;; (if updater (updater (hash-table-ref/default data get-details-sig #f)))) +;; +;; (iup:attribute-set! (dboard:data-get-runs-matrix *data*) "REDRAW" "ALL") +;; ;; (debug:print 2 "run-changes: " run-changes) +;; ;; (debug:print 2 "test-changes: " test-changes) +;; (list run-changes all-test-changes))) ;;====================================================================== ;; TESTS DATA ;;====================================================================== ADDED example_megatest_dotdir/default.dat Index: example_megatest_dotdir/default.dat ================================================================== --- /dev/null +++ example_megatest_dotdir/default.dat @@ -0,0 +1,9 @@ +[mfstest] +path /mfs/matt/data/megatest/tests/fullrun +order 1 +[mfsbig] +path /mfs/matt/data/megatest/tests/fdktestqa/testqa +order 2 +[localtest] +path /home/matt/data/megatest/tests/fullrun +order 3 ADDED example_megatest_dotdir/settings.cfg Index: example_megatest_dotdir/settings.cfg ================================================================== --- /dev/null +++ example_megatest_dotdir/settings.cfg @@ -0,0 +1,4 @@ +[setup] +record row +# [row|col] : records are switched to row or col in gnumeric + ADDED example_megatest_dotdir/sheet-names.cfg Index: example_megatest_dotdir/sheet-names.cfg ================================================================== --- /dev/null +++ example_megatest_dotdir/sheet-names.cfg @@ -0,0 +1,2 @@ +default +sysmaint ADDED example_megatest_dotdir/sxml/_sheets.sxml Index: example_megatest_dotdir/sxml/_sheets.sxml ================================================================== --- /dev/null +++ example_megatest_dotdir/sxml/_sheets.sxml @@ -0,0 +1,56 @@ +((@ (http://www.w3.org/2001/XMLSchema-instance:schemaLocation + "http://www.gnumeric.org/v9.xsd")) + (http://www.gnumeric.org/v10.dtd:Version + (@ (Minor "17") + (Major "12") + (Full "1.12.17") + (Epoch "1"))) + (http://www.gnumeric.org/v10.dtd:Attributes + (http://www.gnumeric.org/v10.dtd:Attribute + (http://www.gnumeric.org/v10.dtd:name + "WorkbookView::show_horizontal_scrollbar") + (http://www.gnumeric.org/v10.dtd:value "TRUE")) + (http://www.gnumeric.org/v10.dtd:Attribute + (http://www.gnumeric.org/v10.dtd:name + "WorkbookView::show_vertical_scrollbar") + (http://www.gnumeric.org/v10.dtd:value "TRUE")) + (http://www.gnumeric.org/v10.dtd:Attribute + (http://www.gnumeric.org/v10.dtd:name + "WorkbookView::show_notebook_tabs") + (http://www.gnumeric.org/v10.dtd:value "TRUE")) + (http://www.gnumeric.org/v10.dtd:Attribute + (http://www.gnumeric.org/v10.dtd:name + "WorkbookView::do_auto_completion") + (http://www.gnumeric.org/v10.dtd:value "TRUE")) + (http://www.gnumeric.org/v10.dtd:Attribute + (http://www.gnumeric.org/v10.dtd:name + "WorkbookView::is_protected") + (http://www.gnumeric.org/v10.dtd:value "FALSE"))) + (urn:oasis:names:tc:opendocument:xmlns:office:1.0:document-meta + (@ (urn:oasis:names:tc:opendocument:xmlns:office:1.0:version + "1.2")) + (urn:oasis:names:tc:opendocument:xmlns:office:1.0:meta + (http://purl.org/dc/elements/1.1/:date + "2015-04-07T05:26:56Z") + (urn:oasis:names:tc:opendocument:xmlns:meta:1.0:creation-date + "2015-04-07T05:25:23Z"))) + (http://www.gnumeric.org/v10.dtd:Calculation + (@ (MaxIterations "100") + (ManualRecalc "0") + (IterationTolerance "0.001") + (FloatRadix "2") + (FloatDigits "53") + (EnableIteration "1"))) + (http://www.gnumeric.org/v10.dtd:SheetNameIndex + (http://www.gnumeric.org/v10.dtd:SheetName + (@ (http://www.gnumeric.org/v10.dtd:Rows "65536") + (http://www.gnumeric.org/v10.dtd:Cols "256")) + "default") + (http://www.gnumeric.org/v10.dtd:SheetName + (@ (http://www.gnumeric.org/v10.dtd:Rows "65536") + (http://www.gnumeric.org/v10.dtd:Cols "256")) + "sysmaint")) + (http://www.gnumeric.org/v10.dtd:Geometry + (@ (Width "1053") (Height "639"))) + (http://www.gnumeric.org/v10.dtd:UIData + (@ (SelectedTab "0")))) ADDED example_megatest_dotdir/sxml/_workbook.sxml Index: example_megatest_dotdir/sxml/_workbook.sxml ================================================================== --- /dev/null +++ example_megatest_dotdir/sxml/_workbook.sxml @@ -0,0 +1,1 @@ +(*TOP* (*PI* xml "version=\"1.0\" encoding=\"UTF-8\"")) ADDED example_megatest_dotdir/sxml/default.sxml Index: example_megatest_dotdir/sxml/default.sxml ================================================================== --- /dev/null +++ example_megatest_dotdir/sxml/default.sxml @@ -0,0 +1,157 @@ +(http://www.gnumeric.org/v10.dtd:Sheet + (@ (Visibility "GNM_SHEET_VISIBILITY_VISIBLE") + (OutlineSymbolsRight "1") + (OutlineSymbolsBelow "1") + (HideZero "0") + (HideRowHeader "0") + (HideGrid "0") + (HideColHeader "0") + (GridColor "0:0:0") + (DisplayOutlines "1") + (DisplayFormulas "0")) + (http://www.gnumeric.org/v10.dtd:MaxCol "3") + (http://www.gnumeric.org/v10.dtd:MaxRow "8") + (http://www.gnumeric.org/v10.dtd:Zoom "1") + (http://www.gnumeric.org/v10.dtd:Names + (http://www.gnumeric.org/v10.dtd:Name + (http://www.gnumeric.org/v10.dtd:name + "Print_Area") + (http://www.gnumeric.org/v10.dtd:value "#REF!") + (http://www.gnumeric.org/v10.dtd:position "A1")) + (http://www.gnumeric.org/v10.dtd:Name + (http://www.gnumeric.org/v10.dtd:name + "Sheet_Title") + (http://www.gnumeric.org/v10.dtd:value + "\"default\"") + (http://www.gnumeric.org/v10.dtd:position "A1"))) + (http://www.gnumeric.org/v10.dtd:PrintInformation + (http://www.gnumeric.org/v10.dtd:Margins + (http://www.gnumeric.org/v10.dtd:top + (@ (PrefUnit "mm") (Points "120"))) + (http://www.gnumeric.org/v10.dtd:bottom + (@ (PrefUnit "mm") (Points "120"))) + (http://www.gnumeric.org/v10.dtd:left + (@ (PrefUnit "mm") (Points "72"))) + (http://www.gnumeric.org/v10.dtd:right + (@ (PrefUnit "mm") (Points "72"))) + (http://www.gnumeric.org/v10.dtd:header + (@ (PrefUnit "mm") (Points "72"))) + (http://www.gnumeric.org/v10.dtd:footer + (@ (PrefUnit "mm") (Points "72")))) + (http://www.gnumeric.org/v10.dtd:Scale + (@ (type "percentage") (percentage "100"))) + (http://www.gnumeric.org/v10.dtd:vcenter + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:hcenter + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:grid + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:even_if_only_styles + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:monochrome + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:draft + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:titles + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:do_not_print + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:print_range + (@ (value "GNM_PRINT_ACTIVE_SHEET"))) + (http://www.gnumeric.org/v10.dtd:order + "d_then_r") + (http://www.gnumeric.org/v10.dtd:orientation + "portrait") + (http://www.gnumeric.org/v10.dtd:Header + (@ (Right "") (Middle "&[TAB]") (Left ""))) + (http://www.gnumeric.org/v10.dtd:Footer + (@ (Right "") (Middle "Page &[PAGE]") (Left ""))) + (http://www.gnumeric.org/v10.dtd:paper + "na_letter") + (http://www.gnumeric.org/v10.dtd:comments + (@ (placement "GNM_PRINT_COMMENTS_IN_PLACE"))) + (http://www.gnumeric.org/v10.dtd:errors + (@ (PrintErrorsAs "GNM_PRINT_ERRORS_AS_DISPLAYED")))) + (http://www.gnumeric.org/v10.dtd:Styles + (http://www.gnumeric.org/v10.dtd:StyleRegion + (@ (startRow "0") + (startCol "0") + (endRow "65530") + (endCol "255")) + (http://www.gnumeric.org/v10.dtd:Style + (@ (WrapText "0") + (VAlign "GNM_VALIGN_BOTTOM") + (ShrinkToFit "0") + (Shade "0") + (Rotation "0") + (PatternColor "0:0:0") + (Locked "1") + (Indent "0") + (Hidden "0") + (HAlign "GNM_HALIGN_GENERAL") + (Format "General") + (Fore "0:0:0") + (Back "FFFF:FFFF:FFFF")) + (http://www.gnumeric.org/v10.dtd:Font + (@ (Unit "10") + (Underline "0") + (StrikeThrough "0") + (Script "0") + (Italic "0") + (Bold "0")) + "Sans"))) + (http://www.gnumeric.org/v10.dtd:StyleRegion + (@ (startRow "65531") + (startCol "0") + (endRow "65535") + (endCol "255")) + (http://www.gnumeric.org/v10.dtd:Style + (@ (WrapText "0") + (VAlign "GNM_VALIGN_BOTTOM") + (ShrinkToFit "0") + (Shade "0") + (Rotation "0") + (PatternColor "0:0:0") + (Locked "1") + (Indent "0") + (Hidden "0") + (HAlign "GNM_HALIGN_GENERAL") + (Format "General") + (Fore "0:0:0") + (Back "FFFF:FFFF:FFFF")) + (http://www.gnumeric.org/v10.dtd:Font + (@ (Unit "10") + (Underline "0") + (StrikeThrough "0") + (Script "0") + (Italic "0") + (Bold "0")) + "Sans")))) + (http://www.gnumeric.org/v10.dtd:Cols + (@ (DefaultSizePts "48")) + (http://www.gnumeric.org/v10.dtd:ColInfo + (@ (Unit "40.5") (No "0"))) + (http://www.gnumeric.org/v10.dtd:ColInfo + (@ (Unit "213") (No "1"))) + (http://www.gnumeric.org/v10.dtd:ColInfo + (@ (Unit "27") (No "2")))) + (http://www.gnumeric.org/v10.dtd:Rows + (@ (DefaultSizePts "12.75"))) + (http://www.gnumeric.org/v10.dtd:Selections + (@ (CursorRow "4") (CursorCol "2")) + (http://www.gnumeric.org/v10.dtd:Selection + (@ (startRow "4") + (startCol "2") + (endRow "4") + (endCol "2")))) + (http://www.gnumeric.org/v10.dtd:SheetLayout + (@ (TopLeft "A1"))) + (http://www.gnumeric.org/v10.dtd:Solver + (@ (ProgramR "0") + (ProblemType "0") + (NonNeg "1") + (ModelType "0") + (MaxTime "60") + (MaxIter "1000") + (Discr "0") + (AutoScale "0")))) ADDED example_megatest_dotdir/sxml/sysmaint.sxml Index: example_megatest_dotdir/sxml/sysmaint.sxml ================================================================== --- /dev/null +++ example_megatest_dotdir/sxml/sysmaint.sxml @@ -0,0 +1,155 @@ +(http://www.gnumeric.org/v10.dtd:Sheet + (@ (Visibility "GNM_SHEET_VISIBILITY_VISIBLE") + (OutlineSymbolsRight "1") + (OutlineSymbolsBelow "1") + (HideZero "0") + (HideRowHeader "0") + (HideGrid "0") + (HideColHeader "0") + (GridColor "0:0:0") + (DisplayOutlines "1") + (DisplayFormulas "0")) + (http://www.gnumeric.org/v10.dtd:MaxCol "3") + (http://www.gnumeric.org/v10.dtd:MaxRow "9") + (http://www.gnumeric.org/v10.dtd:Zoom "1") + (http://www.gnumeric.org/v10.dtd:Names + (http://www.gnumeric.org/v10.dtd:Name + (http://www.gnumeric.org/v10.dtd:name + "Print_Area") + (http://www.gnumeric.org/v10.dtd:value "#REF!") + (http://www.gnumeric.org/v10.dtd:position "A1")) + (http://www.gnumeric.org/v10.dtd:Name + (http://www.gnumeric.org/v10.dtd:name + "Sheet_Title") + (http://www.gnumeric.org/v10.dtd:value + "\"sysmaint\"") + (http://www.gnumeric.org/v10.dtd:position "A1"))) + (http://www.gnumeric.org/v10.dtd:PrintInformation + (http://www.gnumeric.org/v10.dtd:Margins + (http://www.gnumeric.org/v10.dtd:top + (@ (PrefUnit "mm") (Points "120"))) + (http://www.gnumeric.org/v10.dtd:bottom + (@ (PrefUnit "mm") (Points "120"))) + (http://www.gnumeric.org/v10.dtd:left + (@ (PrefUnit "mm") (Points "72"))) + (http://www.gnumeric.org/v10.dtd:right + (@ (PrefUnit "mm") (Points "72"))) + (http://www.gnumeric.org/v10.dtd:header + (@ (PrefUnit "mm") (Points "72"))) + (http://www.gnumeric.org/v10.dtd:footer + (@ (PrefUnit "mm") (Points "72")))) + (http://www.gnumeric.org/v10.dtd:Scale + (@ (type "percentage") (percentage "100"))) + (http://www.gnumeric.org/v10.dtd:vcenter + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:hcenter + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:grid + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:even_if_only_styles + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:monochrome + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:draft + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:titles + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:do_not_print + (@ (value "0"))) + (http://www.gnumeric.org/v10.dtd:print_range + (@ (value "GNM_PRINT_ACTIVE_SHEET"))) + (http://www.gnumeric.org/v10.dtd:order + "d_then_r") + (http://www.gnumeric.org/v10.dtd:orientation + "portrait") + (http://www.gnumeric.org/v10.dtd:Header + (@ (Right "") (Middle "&[TAB]") (Left ""))) + (http://www.gnumeric.org/v10.dtd:Footer + (@ (Right "") (Middle "Page &[PAGE]") (Left ""))) + (http://www.gnumeric.org/v10.dtd:paper + "na_letter") + (http://www.gnumeric.org/v10.dtd:comments + (@ (placement "GNM_PRINT_COMMENTS_IN_PLACE"))) + (http://www.gnumeric.org/v10.dtd:errors + (@ (PrintErrorsAs "GNM_PRINT_ERRORS_AS_DISPLAYED")))) + (http://www.gnumeric.org/v10.dtd:Styles + (http://www.gnumeric.org/v10.dtd:StyleRegion + (@ (startRow "0") + (startCol "0") + (endRow "65529") + (endCol "255")) + (http://www.gnumeric.org/v10.dtd:Style + (@ (WrapText "0") + (VAlign "GNM_VALIGN_BOTTOM") + (ShrinkToFit "0") + (Shade "0") + (Rotation "0") + (PatternColor "0:0:0") + (Locked "1") + (Indent "0") + (Hidden "0") + (HAlign "GNM_HALIGN_GENERAL") + (Format "General") + (Fore "0:0:0") + (Back "FFFF:FFFF:FFFF")) + (http://www.gnumeric.org/v10.dtd:Font + (@ (Unit "10") + (Underline "0") + (StrikeThrough "0") + (Script "0") + (Italic "0") + (Bold "0")) + "Sans"))) + (http://www.gnumeric.org/v10.dtd:StyleRegion + (@ (startRow "65530") + (startCol "0") + (endRow "65535") + (endCol "255")) + (http://www.gnumeric.org/v10.dtd:Style + (@ (WrapText "0") + (VAlign "GNM_VALIGN_BOTTOM") + (ShrinkToFit "0") + (Shade "0") + (Rotation "0") + (PatternColor "0:0:0") + (Locked "1") + (Indent "0") + (Hidden "0") + (HAlign "GNM_HALIGN_GENERAL") + (Format "General") + (Fore "0:0:0") + (Back "FFFF:FFFF:FFFF")) + (http://www.gnumeric.org/v10.dtd:Font + (@ (Unit "10") + (Underline "0") + (StrikeThrough "0") + (Script "0") + (Italic "0") + (Bold "0")) + "Sans")))) + (http://www.gnumeric.org/v10.dtd:Cols + (@ (DefaultSizePts "48")) + (http://www.gnumeric.org/v10.dtd:ColInfo + (@ (Unit "213") (No "1"))) + (http://www.gnumeric.org/v10.dtd:ColInfo + (@ (Unit "27") (No "2")))) + (http://www.gnumeric.org/v10.dtd:Rows + (@ (DefaultSizePts "12.75"))) + (http://www.gnumeric.org/v10.dtd:Selections + (@ (CursorRow "8") (CursorCol "1")) + (http://www.gnumeric.org/v10.dtd:Selection + (@ (startRow "8") + (startCol "1") + (endRow "8") + (endCol "1")))) + (http://www.gnumeric.org/v10.dtd:SheetLayout + (@ (TopLeft "A1"))) + (http://www.gnumeric.org/v10.dtd:Solver + (@ (ProgramR "0") + (ProblemType "0") + (NonNeg "1") + (ModelType "0") + (MaxTime "60") + (MaxIter "1000") + (Discr "0") + (AutoScale "0")))) ADDED example_megatest_dotdir/sysmaint.dat Index: example_megatest_dotdir/sysmaint.dat ================================================================== --- /dev/null +++ example_megatest_dotdir/sysmaint.dat @@ -0,0 +1,9 @@ +[mfstest] +path /mfs/matt/data/megatest/tests/fullrun +order 1 +[mfsbig] +path /mfs/matt/data/megatest/tests/fdktestqa/testqa +order 2 +[localtest] +path /home/matt/data/megatest/tests/fullrun +order 3