Overview
| Comment: | Back to having the dashboard compile and start |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | multi-area |
| Files: | files | file ages | folders |
| SHA1: |
133c9d418362bab238d6e028234078f8 |
| User & Date: | matt on 2015-04-08 23:20:09 |
| Other Links: | branch diff | manifest | tags |
Context
|
2015-04-09
| ||
| 05:27 | updated record initialization check-in: 7b3dfd2ed0 user: matt tags: multi-area | |
|
2015-04-08
| ||
| 23:20 | Back to having the dashboard compile and start check-in: 133c9d4183 user: matt tags: multi-area | |
| 18:22 | More clean up check-in: 3eb16c4cd9 user: mrwellan tags: multi-area | |
Changes
Modified dashboard.scm from [50bbb611aa] to [4bd60fe1da].
| ︙ | ︙ | |||
531 532 533 534 535 536 537 |
#: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")
| < | | > > > | | | > > > > > > > > > | < < < < | > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | | 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 |
#: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: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))
;;======================================================================
;; A R E A S
;;======================================================================
(define (dashboard:init-area data area-name apath)
(let* ((mtconffile (conc area-name "/megatest.config"))
(mtconf (read-config mtconffile (make-hash-table) #f)) ;; megatest.config
(area-dat (let ((ad (make-megatest:area
area-name ;; area name
apath ;; path to area
'http ;; transport
(list apath mtconf) ;; configinfo (legacy)
mtconf ;; megatest.config
(make-hash-table) ;; denoise hash
#f ;; client-signature
#f ;; remote connections
#f ;; run keys
(make-hash-table) ;; run-id -> (hash of test-ids => dat)
(and (file-exists? apath)(file-write-access? apath)) ;; read-only
)))
(hash-table-set! (dboard:data-areas data) area-name ad)
ad)))
area-dat))
;;======================================================================
;; D A S H B O A R D
;;======================================================================
;; 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)
(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))
(areas (dboard:data-areas data))
(dboard-dat (make-dboard:area
#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)
(iup:split
#:value 200
tb ad)))
area-names))
(tabtop (apply iup:tabs area-panels)))
(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 (newdashboard data window-id)
(let* (;; (keys (db:get-keys *dbstruct-local* *area-dat*))
;; (runname "%")
;; (testpatt "%")
;; (keypatts (map (lambda (k)(list k "%")) keys))
;; (states '())
|
| ︙ | ︙ |