Overview
Comment: | Cherrypicked changes |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | mtdboard |
Files: | files | file ages | folders |
SHA1: |
01385661b35b525676506bbf207be52d |
User & Date: | ritikaag on 2016-05-02 15:56:43 |
Other Links: | branch diff | manifest | tags |
Context
2016-05-18
| ||
15:51 | Merged with the latest 1.61/02 changes check-in: 3f21429f4f user: ritikaag tags: mtdboard | |
2016-05-02
| ||
15:56 | Cherrypicked changes check-in: 01385661b3 user: ritikaag tags: mtdboard | |
12:23 | fixed sretrive to ignore bad links check-in: bb799c9f43 user: pjhatwal tags: v1.61, v1.6101a | |
Changes
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 [aaaadfcd53].
︙ | ︙ | |||
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 |
︙ | ︙ | |||
410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 | (define (dashboard:main-matrix data adat window-id) (let* (;; (tab-dat (areadat- (view-matrix (iup:matrix ;; (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f)) #:expand "YES" ;; #:fittosize "YES" #: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 | > > > > > > > > > > | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 | (define (dashboard:main-matrix data adat window-id) (let* (;; (tab-dat (areadat- (view-matrix (iup:matrix ;; (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f)) #:expand "YES" ;; #:fittosize "YES" #:resizematrix "YES" #:menucontext "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)) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 577 | ;; (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" | | | 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 | ;; 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 () | | > > > > | | > > | 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 836 837 838 839 840 | ;; ) (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:show (layout-dialog (dashboard:main-panel data window-id))) (iup:main-loop))) ;; ease debugging by loading ~/.dashboardrc (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc"))) (if (file-exists? debugcontrolf) (load debugcontrolf))) |
︙ | ︙ |
Modified tests/fullrun/multi-dboard.sh from [b641343611] to [9629538735].
︙ | ︙ | |||
12 13 14 15 16 17 18 | # [local] # localtest /home/matt/data/megatest/tests/fullrun # EOF # fi if [[ ! -e "$HOME/.megatest/default.dat" ]];then cat > "$HOME/.megatest/default.dat" << EOF [fullrun] | | | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | # [local] # localtest /home/matt/data/megatest/tests/fullrun # EOF # fi if [[ ! -e "$HOME/.megatest/default.dat" ]];then cat > "$HOME/.megatest/default.dat" << EOF [fullrun] path /home/USER/myMegatestArea order 1 # [bigrun] # path /mfs/matt/data/megatest/tests/fdktestqa/testqa # 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 |