Overview
| Comment: | More clean up |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | multi-area |
| Files: | files | file ages | folders |
| SHA1: |
3eb16c4cd988e55b34f49fd94ddfdb05 |
| User & Date: | mrwellan on 2015-04-08 18:22:52 |
| Other Links: | branch diff | manifest | tags |
Context
|
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 | |
|
2015-04-07
| ||
| 09:07 | Stuff eh. On the shuttle check-in: 5baad3fe0b user: matt tags: multi-area | |
Changes
Modified common.scm from [609c3adc2f] to [5db22c5710].
| ︙ | ︙ | |||
34 35 36 37 38 39 40 |
(debug:print 0 "ERROR: bad value for setenv, key=" key ", value=" val)))
(define home (getenv "HOME"))
(define user (getenv "USER"))
;; GLOBAL GLETCHES
(define-record megatest:area
| | | | | | | | | | > | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 |
(debug:print 0 "ERROR: bad value for setenv, key=" key ", value=" val)))
(define home (getenv "HOME"))
(define user (getenv "USER"))
;; GLOBAL GLETCHES
(define-record megatest:area
name ;; area name
path ;; mt run area home
transport ;; defaults to http
configinfo ;; legacy config format
configdat ;; megatest config
denoise ;; focal point for not
client-signature ;; key for client-server conversation
remote ;; hash of all the client side connnections
run-keys ;; target keys for this area
runs ;; used in dashboard
read-only ;; can I write to this area?
)
(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 [42ca30b425] to [50bbb611aa].
| ︙ | ︙ | |||
61 62 63 64 65 66 67 |
0))
(if (args:get-arg "-h")
(begin
(print help)
(exit)))
| < < < < < < < < < < < < < < < < < | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 |
0))
(if (args:get-arg "-h")
(begin
(print help)
(exit)))
;; (if (args:get-arg "-host")
;; (begin
;; (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":")))
;; (client:launch))
;; (client:launch))
;; ease debugging by loading ~/.dashboardrc
|
| ︙ | ︙ | |||
566 567 568 569 570 571 572 | (iup:hbox)) ;;====================================================================== ;; D A S H B O A R D ;;====================================================================== (define (make-area-panel data area-name window-id) | | | 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 |
(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 (dboard:data-areas data) 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
|
| ︙ | ︙ | |||
592 593 594 595 596 597 598 |
(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)))
| | | | > < < | > > > > | | > > > | 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 |
(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) ;; 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) hed
(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
""
))
(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)))))
|
| ︙ | ︙ |
Modified dcommon.scm from [f5b7561c68] to [5d6b4a68c6].
| ︙ | ︙ | |||
44 45 46 47 48 49 50 | areas ;; hash of areaname -> area-rec current-window-id ) (define-record dboard:area tree matrix | < < < < | 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | areas ;; hash of areaname -> area-rec current-window-id ) (define-record dboard:area tree matrix area-dat ;; the one-structure (one day dbstruct will be put in here) 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 ) (define-record dboard:filter target ;; hash of widgets for the target runname ;; the runname widget testpatt ;; the testpatt widget ) |
| ︙ | ︙ |