Overview
Comment: | Stuff eh. On the shuttle |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | multi-area |
Files: | files | file ages | folders |
SHA1: |
5baad3fe0bdc69b5e59c7ae36f2a7497 |
User & Date: | matt on 2015-04-07 09:07:08 |
Other Links: | branch diff | manifest | tags |
Context
2015-04-08
| ||
18:22 | More clean up check-in: 3eb16c4cd9 user: mrwellan tags: multi-area | |
2015-04-07
| ||
09:07 | Stuff eh. On the shuttle check-in: 5baad3fe0b user: matt tags: multi-area | |
2015-04-06
| ||
23:42 | Initial framework for multi-area browser check-in: d70f24bd1d user: matt tags: multi-area | |
Changes
Modified common.scm from [fdc46f2740] to [609c3adc2f].
︙ | ︙ | |||
42 43 44 45 46 47 48 49 50 51 52 53 54 55 | path transport configinfo configdat denoise client-signature remote ) (define *already-seen-runconfig-info* #f) (define *waiting-queue* (make-hash-table)) (define *test-meta-updated* (make-hash-table)) (define *globalexitstatus* 0) ;; attempt to work around possible thread issues (define *passnum* 0) ;; when running track calls to run-tests or similar | > > | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | path transport configinfo configdat denoise client-signature remote run-keys runs ;; used in dashboard ) (define *already-seen-runconfig-info* #f) (define *waiting-queue* (make-hash-table)) (define *test-meta-updated* (make-hash-table)) (define *globalexitstatus* 0) ;; attempt to work around possible thread issues (define *passnum* 0) ;; when running track calls to run-tests or similar |
︙ | ︙ |
Modified dashboard.scm from [e9e3717492] to [42ca30b425].
︙ | ︙ | |||
439 440 441 442 443 444 445 | steps-matrix data-matrix))) (iup:attribute-set! tabs "TABTITLE0" "Test Steps") (iup:attribute-set! tabs "TABTITLE1" "Test Data") tabs))))) ;; Test browser | | | 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 | steps-matrix data-matrix))) (iup:attribute-set! tabs "TABTITLE0" "Test Steps") (iup:attribute-set! tabs "TABTITLE1" "Test Data") tabs))))) ;; Test browser (define (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) (let* ((tree-path (tree:node->path obj id)) (area (car tree-path)) |
︙ | ︙ | |||
528 529 530 531 532 533 534 | )) (dcommon:populate-steps steps-dat steps-matrix)))))) ;;(list meta-dat-matrix ;; (if test-id ;; (list ( | < < < < < < < < < < < < < < < < < < | | > > > > > > | | > | < | | | | | > > > > > > > > > > > > > > > > > > > > > > > > | | | | | < < | | | 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 | )) (dcommon:populate-steps steps-dat steps-matrix)))))) ;;(list meta-dat-matrix ;; (if test-id ;; (list ( ;;====================================================================== ;; R U N C O N T R O L ;;====================================================================== ;; General displayer ;; (define (area-display data adat window-id) (let* ((view-matrix (iup:matrix #:expand "YES" ;; #:fittosize "YES" #:scrollbar "YES" #:numcol 100 #:numlin 100 #: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! view-matrix "RESIZEMATRIX" "YES") (iup:attribute-set! view-matrix "WIDTH0" "100") (dboard:area-matrix-set! adat view-matrix) ;; (dboard:data-set-runs-matrix! *data* runs-matrix) (iup:hbox (iup:frame #:title "Runs browser" (iup:vbox view-matrix))))) ;; Browse and control a single run ;; (define (runcontrol window-id) (iup:hbox)) ;;====================================================================== ;; D A S H B O A R D ;;====================================================================== (define (make-area-panel data area-name window-id) (let* ((adat (hash-table-ref areas area-name)) (tb (tree-browser data adat window-id)) ;; (dboard:areas-tree-browser data) (ad (area-display data adat window-id)) (areas (dboard:data-areas data))) (dboard:area-tree-set! adat tb) (dboard:area-matrix-set! adat ad) (iup:split #:value 200 tb ad))) ;; Main Panel (define (main-panel data window-id) (iup:dialog #:title "Megatest Control Panel" #:menu (dcommon:main-menu data) #:shrink "YES" (iup:vbox (let* ((area-names (hash-table-keys (dboard:data-cfgdat data))) (area-panels (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))) (let* ((apath (hash-table-ref (dboard:data-cfgdat data)) hed) (mtconf (read-config apath (make-hash-table) #f)) ;; megatest.config (area-dat (make-megatest:area hed ;; area name apath ;; path to area 'http ;; transport (list apath mtconf) ;; configinfo (legacy) mtconf ;; megatest.config (make-hash-table) #f #f ;; remote connections #f ;; run keys (make-hash-table) ;; run-id -> (hash of test-ids => dat) ))) (hash-table-set! (dboard:data-areas data) hed (make-dboard:area #f ;; tree #f ;; matrix (and (file-exists? apath) (file-write-access? apath)) area-dat 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))))) (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: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))) ;; 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) (let ((starttime (current-milliseconds))) ;; Want to dedicate no more than 50% of the time to this so skip if |
︙ | ︙ | |||
646 647 648 649 650 651 652 | ;;; main. Theoretically could have multiple windows (each with a group of tags, thus window-id ;;; (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))) | | | > | < | 656 657 658 659 660 661 662 663 664 665 666 667 668 669 | ;;; main. Theoretically could have multiple windows (each with a group of tags, thus window-id ;;; (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:data cfgdat ;; this is the data from ~/.megatest for the selected group (make-hash-table) ;; areaname -> area-rec 0 ))) (newdashboard data window-id) (iup:main-loop)) |
Modified dcommon.scm from [c2f511dfd7] to [f5b7561c68].
︙ | ︙ | |||
35 36 37 38 39 40 41 | ;;====================================================================== ;; ;; A single data structure for all the data used in a dashboard for ;; all areas tracked. ;; | | | > < > > < > < < < | < | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 | ;;====================================================================== ;; ;; A single data structure for all the data used in a dashboard for ;; all areas tracked. ;; (define-record dboard:data cfgdat ;; data from ~/.megatest/<group>.dat areas ;; hash of areaname -> area-rec current-window-id ) (define-record dboard:area tree matrix read-only ;; #t => can't write area-dat ;; the one-structure (one day dbstruct will be put in here) name ;; name for this area mpath ;; path to the megatest home (MT_RUN_AREA_HOME) view-path ;; <target/path>/<runname>/... 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 command ;; the command from the entry field ;; dbstruct ;; not needed ) (define-record dboard:filter target ;; hash of widgets for the target runname ;; the runname widget testpatt ;; the testpatt widget ) ;; Use megatest:area from common.scm for an area record ;;====================================================================== ;; D O T F I L E ;;====================================================================== ;; write a sexp list to fname ;; |
︙ | ︙ |