Overview
Comment: | Light rearrangement and code cleanup |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | development |
Files: | files | file ages | folders |
SHA1: |
6694a9d30517cfbefd3fe61784c6e248 |
User & Date: | matt on 2013-03-20 21:23:30 |
Other Links: | branch diff | manifest | tags |
Context
2013-03-20
| ||
23:14 | Added widgets for test control panel check-in: 2dd5efefd7 user: matt tags: development | |
21:23 | Light rearrangement and code cleanup check-in: 6694a9d305 user: matt tags: development | |
18:07 | More tree related implementation check-in: 5818d8e775 user: mrwellan tags: development | |
Changes
Modified newdashboard.scm from [19253eb31b] to [5cd724371b].
︙ | ︙ | |||
297 298 299 300 301 302 303 | ;; The runconfigs.config file ;; (define (rconfig) (iup:vbox (iup:frame #:title "Default"))) ;;====================================================================== | | | 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 | ;; The runconfigs.config file ;; (define (rconfig) (iup:vbox (iup:frame #:title "Default"))) ;;====================================================================== ;; T R E E S T U F F ;;====================================================================== ;; path is a list of nodes, each the child of the previous ;; this routine returns the id so another node can be added ;; either as a leaf or as a branch ;; ;; BUG: This needs a stop sensor for when a branch is exhausted |
︙ | ︙ | |||
364 365 366 367 368 369 370 371 372 373 374 375 | #t ;; reset to top (loop (car nodelst)(cdr nodelst) 1 (list top)))) (if (null? tal) ;; if null here then this path has already been added #t (loop (car tal)(cdr tal)(+ depth 1) newpath)))))))) ;; Test browser (define (tests) (iup:hbox (let* ((tb (iup:treebox | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > > > | 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 | #t ;; reset to top (loop (car nodelst)(cdr nodelst) 1 (list top)))) (if (null? tal) ;; if null here then this path has already been added #t (loop (car tal)(cdr tal)(+ depth 1) newpath)))))))) (define (tree-node->path obj nodenum) ;; (print "\ncurrnode nodenum depth node-depth node-title path") (let loop ((currnode 0) (depth 0) (path '())) (let ((node-depth (iup:attribute obj (conc "DEPTH" currnode))) (node-title (iup:attribute obj (conc "TITLE" currnode)))) ;; (display (conc "\n "currnode " " nodenum " " depth " " node-depth " " node-title " " path)) (if (> currnode nodenum) path (if (not node-depth) ;; #f if we are out of nodes '() (let ((ndepth (string->number node-depth))) (if (eq? ndepth depth) ;; This next is the match condition depth == node-depth (if (eq? currnode nodenum) (begin ;; (display " <X>") (append path (list node-title))) (loop (+ currnode 1) (+ depth 1) (append path (list node-title)))) ;; didn't match, reset to base path and keep looking ;; due to more iup odditys we don't reset to base (begin ;; (display " <L>") (loop (+ 1 currnode) 2 (append (take path ndepth)(list node-title))))))))))) ;;====================================================================== ;; T E S T S ;;====================================================================== ;; Test browser (define (tests) (iup:hbox (let* ((tb (iup:treebox #:selection-cb (lambda (obj id state) (print "obj: " obj ", id: " id ", state: " state) (print "path: " (tree-node->path obj 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) (iup:vbox ))) ;;====================================================================== ;; R U N C O N T R O L ;;====================================================================== ;; Overall runs browser ;; (define (runs) (let* ((runs-matrix (iup:matrix #:expand "YES" ;; #:fittosize "YES" #:scrollbar "YES" |
︙ | ︙ | |||
408 409 410 411 412 413 414 | runs-matrix))))) ;; Browse and control a single run ;; (define (runcontrol) (iup:hbox)) | < < < < < < < < < < < < < < < < < < < | | 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 | runs-matrix))))) ;; Browse and control a single run ;; (define (runcontrol) (iup:hbox)) ;;====================================================================== ;; P R O C E S S R U N S ;;====================================================================== ;; MOVE THIS INTO *data* (define *cachedata* (make-hash-table)) (hash-table-set! *cachedata* "runid-to-col" (make-hash-table)) (hash-table-set! *cachedata* "testname-to-row" (make-hash-table)) |
︙ | ︙ | |||
567 568 569 570 571 572 573 | run-ids) (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 test-changes))) | > > > | > > > > > > > > > > > > > > > > > > > | 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 | run-ids) (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 test-changes))) ;;====================================================================== ;; D A S H B O A R D ;;====================================================================== ;; Main Panel (define (main-panel) (iup:dialog #:title "Megatest Control Panel" #:menu (main-menu) (let ((tabtop (iup:tabs (runs) (tests) (runcontrol) (mtest) (rconfig) ))) (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))) (define (newdashboard) (let* ((data (make-hash-table)) (keys (cdb:remote-run db:get-keys #f)) (runname "%") (testpatt "%") (keypatts (map (lambda (k)(list (vector-ref k 0) "%")) keys)) (states '()) |
︙ | ︙ |