Changes In Branch mtdboard_defunct Through [a43a49988b] Excluding Merge-Ins
This is equivalent to a diff from 705ae1d971 to a43a49988b
2016-04-22
| ||
11:53 | Changes to mboard file: pop-up menu Closed-Leaf check-in: 63864cd735 user: ritikaag tags: mtdboard_defunct | |
2016-04-21
| ||
09:59 | Added popup-menu based on Thomas Chust's feedback check-in: a43a49988b user: mrwellan tags: mtdboard_defunct | |
2016-03-22
| ||
14:52 | Multi-dashboard changes check-in: 1f80fdebfa user: ritikaag tags: mtdboard_defunct | |
2016-03-21
| ||
09:34 | Manual tweaks to display of tests check-in: de6124e350 user: mrwellan tags: v1.60_defunct | |
2016-03-15
| ||
23:42 | More dashboard refactoring check-in: 705ae1d971 user: matt tags: v1.60_defunct | |
00:55 | Added start of new updater for new view check-in: 650e5b177a user: matt tags: v1.60_defunct | |
Modified configf.scm from [d0b9504482] to [db46ea817f].
︙ | ︙ | |||
38 39 40 41 42 43 44 45 46 47 48 49 50 51 | (loop remcwd))))))))) (define (config:assoc-safe-add alist key val #!key (metadata #f)) (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist))) (append newalist (list (if metadata (list key val metadata) (list key val)))))) (define (config:eval-string-in-environment str) (handle-exceptions exn (begin (debug:print 0 "ERROR: problem evaluating \"" str "\" in the shell environment") #f) | > > > > > > | 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | (loop remcwd))))))))) (define (config:assoc-safe-add alist key val #!key (metadata #f)) (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist))) (append newalist (list (if metadata (list key val metadata) (list key val)))))) (define (configf:set-section-var cfgdat section var value) (let ((sect (hash-table-ref/default cfgdat section '()))) (hash-table-set! cfgdat section (config:assoc-safe-add sect var value)))) (define (config:eval-string-in-environment str) (handle-exceptions exn (begin (debug:print 0 "ERROR: problem evaluating \"" str "\" in the shell environment") #f) |
︙ | ︙ | |||
594 595 596 597 598 599 600 | (let* ((var (car dat-pair)) (val (cadr dat-pair)) (fname (if (> (length dat-pair) 2)(caddr dat-pair) #f))) (if fname (print "# " var "=>" fname)) (print var " " val))) section-dat))) ;; (print "section-dat: " section-dat)) (hash-table->alist data))) | > > | 600 601 602 603 604 605 606 607 608 | (let* ((var (car dat-pair)) (val (cadr dat-pair)) (fname (if (> (length dat-pair) 2)(caddr dat-pair) #f))) (if fname (print "# " var "=>" fname)) (print var " " val))) section-dat))) ;; (print "section-dat: " section-dat)) (hash-table->alist data))) |
Modified multi-dboard.scm from [3d4abbfc1d] to [c50a2e3f73].
︙ | ︙ | |||
161 162 163 164 165 166 167 168 169 170 171 172 173 174 | (define-record data cfgdat ;; data from ~/.megatest/<group>.dat areas ;; hash of areaname -> area-rec current-window-id ;; current-tab-id ;; update-needed ;; flag to indicate that the tab pointed to by current tab id needs refreshing immediately tabs ;; hash of tab-id -> areaname (??) should be of type "tab" ) ;; all the components of an area display, all fits into a tab but ;; parts may be swapped in/out as needed ;; (define-record tab tree | > | 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | (define-record data cfgdat ;; data from ~/.megatest/<group>.dat areas ;; hash of areaname -> area-rec current-window-id ;; current-tab-id ;; update-needed ;; flag to indicate that the tab pointed to by current tab id needs refreshing immediately tabs ;; hash of tab-id -> areaname (??) should be of type "tab" groupn ;; ) ;; all the components of an area display, all fits into a tab but ;; parts may be swapped in/out as needed ;; (define-record tab tree |
︙ | ︙ | |||
416 417 418 419 420 421 422 423 424 425 426 427 428 429 | #:resizematrix "YES" #:scrollbar "YES" #:numcol 100 #:numlin 100 #:numcol-visible 3 #:numlin-visible 20 #:click-cb (lambda (obj lin col status) (print "obj: " obj " lin: " lin " col: " col " status: " status " value: " (iup:attribute obj "VALUE")))))) ;; (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 | > > > > > > > > > | 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 | #:resizematrix "YES" #:scrollbar "YES" #:numcol 100 #:numlin 100 #:numcol-visible 3 #:numlin-visible 20 #:click-cb (lambda (obj lin col status) (let ((popup-menu (iup:menu (iup:menu-item "Remove test" #:action (lambda (obj)(print "Removing test")))))) (iup:show popup-menu #:x 'mouse #:y 'mouse #:modal? "NO") (print "got here")) (print "obj: " obj " lin: " lin " col: " col " status: " status " value: " (iup:attribute obj "VALUE")))))) ;; (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 |
︙ | ︙ | |||
515 516 517 518 519 520 521 522 523 524 525 526 527 528 | ;; (dboard:clear-matrix current-matrix used-cols used-rows touched) ;; clear all ;;====================================================================== ;; D A S H B O A R D ;;====================================================================== (define (dashboard:area-panel aname data window-id) (let* ((apath (configf:lookup (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 (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data) (ad (dashboard:main-matrix data area-dat window-id)) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 525 526 527 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 | ;; (dboard:clear-matrix current-matrix used-cols used-rows touched) ;; clear all ;;====================================================================== ;; D A S H B O A R D ;;====================================================================== ;; The main menu (define (dcommon:main-menu data) (iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top) (iup:menu-item "Files" (iup:menu ;; Note that you can use either #:action or action: for options (iup:menu-item "Open" action: (lambda (obj) (let* ((area-name (iup:textbox #:expand "HORIZONTAL")) (fd (iup:file-dialog #:dialogtype "DIR")) (top (iup:show fd #:modal? "YES"))) (iup:attribute-set! source-tb "VALUE" (iup:attribute fd "VALUE")) (iup:destroy! fd)))) (iup:menu-item "Open area" action: (lambda (obj) (let* ((area-name (iup:textbox #:expand "HORIZONTAL")) (fd (iup:file-dialog #:dialogtype "DIR")) (top (iup:show fd #:modal? "YES")) ;;(source-tb (iup:textbox #:expand "HORIZONTAL")) (cfgdat (data-cfgdat data)) (fname (conc (getenv "HOME") "/.megatest/" (data-groupn data) ".dat")) ) ;;(iup:attribute-set! source-tb "VALUE" ;; (iup:attribute fd "VALUE")) (configf:set-section-var cfgdat "lvqa" "path" (iup:attribute fd "VALUE")) (configf:write-alist cfgdat fname) (iup:destroy! fd)))) (iup:menu-item "Save" #:action (lambda (obj)(print "File->save " obj))) (iup:menu-item "Exit" #:action (lambda (obj)(exit))))) (iup:menu-item "Tools" (iup:menu (iup:menu-item "Create new blah" #:action (lambda (obj)(print "Tools->new blah"))) ;; (iup:menu-item "Show dialog" #:action (lambda (obj) ;; (show message-window ;; #:modal? #t ;; ;; set positon using coordinates or center, start, top, left, end, bottom, right, parent-center, current ;; ;; #:x 'mouse ;; ;; #:y 'mouse ;; ) )))) (define (dashboard:area-panel aname data window-id) (let* ((apath (configf:lookup (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 (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data) (ad (dashboard:main-matrix data area-dat window-id)) |
︙ | ︙ | |||
552 553 554 555 556 557 558 | ;; Main Panel ;; (define (dashboard:main-panel data window-id) (iup:dialog #:title "Megatest Control Panel" | | | 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 | ;; Main Panel ;; (define (dashboard: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 (data-cfgdat data))) (area-panels (map (lambda (aname) (dashboard:area-panel aname data window-id)) area-names)) (tabtop (apply iup:tabs |
︙ | ︙ | |||
747 748 749 750 751 752 753 | ;; ) (define (dboard:read-mtconf apath) (let* ((mtconffile (conc apath "/megatest.config"))) (call-with-environment-variables (list (cons "MT_RUN_AREA_HOME" apath)) (lambda () | | > > > > | | > | 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 | ;; ) (define (dboard:read-mtconf apath) (let* ((mtconffile (conc apath "/megatest.config"))) (call-with-environment-variables (list (cons "MT_RUN_AREA_HOME" apath)) (lambda () (let ((res (read-config mtconffile (make-hash-table) #f))) ;; megatest.config (if (hash-table? res) res (begin (debug:print 0 "WARNING: failed to read " mtconffile) (make-hash-table)))))))) ;;====================================================================== ;; G U I S T U F F ;;====================================================================== ;;; main. Theoretically could have multiple windows (each with a group of tags, thus window-id ;;; (define (dboard:make-window window-id) (let* (;; (window-id 0) (groupn (or (args:get-arg "-group") "default")) (cfgdat (dboard:get-config groupn)) ;; (cfgdat (if (file-exists? cfname)(read-config cfname (make-hash-table) #t)(make-hash-table))) (data (make-data cfgdat ;; this is the data from ~/.megatest for the selected group (make-hash-table) ;; areaname -> area-rec 0 ;; current window id 0 ;; current tab id #f ;; redraw needed for current tab id (make-hash-table) ;; tab-id -> areaname groupn ))) (hash-table-set! *windows* window-id data) (iup:show (dashboard:main-panel data window-id)) (iup:main-loop))) ;; ease debugging by loading ~/.dashboardrc (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc"))) |
︙ | ︙ |
Modified tests/fullrun/multi-dboard.sh from [b641343611] to [5229cb1882].
︙ | ︙ | |||
23 24 25 26 27 28 29 | # order 2 # [local_fullrun] # path /home/matt/data/megatest/tests/fullrun # order 3 EOF fi | | | 23 24 25 26 27 28 29 30 | # order 2 # [local_fullrun] # path /home/matt/data/megatest/tests/fullrun # order 3 EOF fi /nfs/pdx/disks/icf_external/pkgs/chicken/4.10.0/bin/csi -I ../.. multi-dboard-load-all.scm |