Changes In Branch mtdboard Through [79aa38f270] Excluding Merge-Ins
This is equivalent to a diff from c2ba631f76 to 79aa38f270
|
2016-06-23
| ||
| 14:42 | Merged latest changes from v1.61 check-in: bb7e0b59c7 user: ritikaag tags: mtdboard | |
|
2016-06-21
| ||
| 17:11 | Added xterm function check-in: 79aa38f270 user: ritikaag tags: mtdboard | |
| 04:06 | Merging first phase of redir-logs into v1.61 check-in: 1f31d511c0 user: matt tags: v1.61 | |
|
2016-06-16
| ||
| 03:19 | Added param for overriding port to debug:print and debug:print-info check-in: 7b4d2dba0e user: matt tags: redir-logs | |
|
2016-05-18
| ||
| 15:51 | Merged with the latest 1.61/02 changes check-in: 3f21429f4f user: ritikaag tags: mtdboard | |
| 11:21 | Forced cleanup db on changing versions check-in: c2ba631f76 user: ritikaag tags: v1.61 | |
|
2016-05-16
| ||
| 17:13 | Split show/hide to two buttons check-in: cf1f6d704a user: mrwellan tags: v1.61 | |
Modified Makefile from [9afa174d56] to [1879ee0391].
| ︙ | ︙ | |||
226 227 228 229 230 231 232 233 |
chicken-install -keep-installed $(PROXY) -deploy -prefix sretrieve defstruct srfi-18 format sql-de-lite \
srfi-1 posix regex regex-case srfi-69
# base64 dot-locking \
# csv-xml z3
# "(define (toplevel-command . a) #f)"
readline-fix.scm :
| > > < > | | | 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 |
chicken-install -keep-installed $(PROXY) -deploy -prefix sretrieve defstruct srfi-18 format sql-de-lite \
srfi-1 posix regex regex-case srfi-69
# base64 dot-locking \
# csv-xml z3
# "(define (toplevel-command . a) #f)"
# if egrep 'version.*3.0' $(shell dirname $(shell dirname $(shell which csi)))/lib/chicken/7/readline.setup-info;then \
readline-fix.scm :
if [[ $(shell chicken-status | grep readline | awk '{print $4}' | cut -d. -f1) -gt 3 ]];then \
echo "(define *use-new-readline* #f)" > readline-fix.scm; \
else \
echo "(define *use-new-readline* #t)" > readline-fix.scm;\
fi
altdb.scm :
echo ";; optional alternate db setup" > altdb.scm
echo "(define *available-db* (make-hash-table))" >> altdb.scm
if csi -ne '(use mysql-client)';then \
echo "(use mysql-client)(hash-table-set! *available-db* 'mysql #t)" >> altdb.scm; \
|
| ︙ | ︙ |
Modified configf.scm from [805ef5eee8] to [2a38521341].
| ︙ | ︙ | |||
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 dashboard.scm from [dfc3e5bd3f] to [171edecc6b].
| ︙ | ︙ | |||
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 | version " megatest-version " license GPL, Copyright (C) Matt Welland 2012-2016 Usage: dashboard [options] -h : this help -server host:port : connect to host:port instead of db access -test run-id,test-id : control test identified by testid -guimonitor : control panel for runs Misc -rows N : set number of rows ")) ;; process args (define remargs (args:get-args (argv) (list "-rows" "-run" "-test" "-debug" "-host" "-transport" ) (list "-h" "-use-server" "-guimonitor" | > > | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 |
version " megatest-version "
license GPL, Copyright (C) Matt Welland 2012-2016
Usage: dashboard [options]
-h : this help
-server host:port : connect to host:port instead of db access
-test run-id,test-id : control test identified by testid
-xterm run-id,test-id : Start a new xterm with specified run-id and test-id
-guimonitor : control panel for runs
Misc
-rows N : set number of rows
"))
;; process args
(define remargs (args:get-args
(argv)
(list "-rows"
"-run"
"-test"
"-xterm"
"-debug"
"-host"
"-transport"
)
(list "-h"
"-use-server"
"-guimonitor"
|
| ︙ | ︙ | |||
1750 1751 1752 1753 1754 1755 1756 |
(set! bdylst (cons (apply iup:vbox (reverse res)) bdylst))
(loop (+ runnum 1) 0 (make-vector ntests) '()))
(else
(let* ((button-key (mkstr runnum testnum))
(butn (iup:button "" ;; button-key
#:size "60x15"
#:expand "HORIZONTAL"
| | | | | | | | | > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > | | 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 |
(set! bdylst (cons (apply iup:vbox (reverse res)) bdylst))
(loop (+ runnum 1) 0 (make-vector ntests) '()))
(else
(let* ((button-key (mkstr runnum testnum))
(butn (iup:button "" ;; button-key
#:size "60x15"
#:expand "HORIZONTAL"
#:fontsize "10"
;; :action (lambda (x)
;; (let* ((toolpath (car (argv)))
;; (buttndat (hash-table-ref (d:alldat-buttondat *alldat*) button-key))
;; (test-id (db:test-get-id (vector-ref buttndat 3)))
;; (run-id (db:test-get-run_id (vector-ref buttndat 3)))
;; (cmd (conc toolpath " -test " run-id "," test-id "&")))
;; ;(print "Launching " cmd)
;; (system cmd)))
#:button-cb (lambda (obj a pressed x y btn . rem)
(print "pressed= " pressed " x= " x " y= " y " rem=" rem " btn=" btn " string? " (string? btn))
(if (substring-index "3" btn)
(if (eq? pressed 0)
(let ((popup-menu (iup:menu
(iup:menu-item
"Run"
(iup:menu
(iup:menu-item
"Rerun"
#:action
(lambda (obj)(print "Rerun")))
(iup:menu-item
"Start xterm"
#:action
(let* ((toolpath (car (argv)))
(buttndat (hash-table-ref (d:alldat-buttondat *alldat*) button-key))
(test-id (db:test-get-id (vector-ref buttndat 3)))
(run-id (db:test-get-run_id (vector-ref buttndat 3)))
(cmd (conc toolpath " -xterm " run-id "," test-id "&")))
(system cmd))
;; (lambda (x)
;; (if (directory-exists? rundir)
;; (let ((shell (if (get-environment-variable "SHELL")
;; (conc "-e " (get-environment-variable "SHELL"))
;; "")))
;; (common:without-vars
;; (conc "cd " rundir
;; ";mt_xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&")
;; "MT_.*"))
;; (message-window (conc "Directory " rundir " not found"))))
))))))
(iup:show popup-menu
#:x 'mouse
#:y 'mouse
#:modal? "NO")
(print "got here")))
(if (eq? pressed 0)
(let* ((toolpath (car (argv)))
(buttndat (hash-table-ref (d:alldat-buttondat *alldat*) button-key))
(test-id (db:test-get-id (vector-ref buttndat 3)))
(run-id (db:test-get-run_id (vector-ref buttndat 3)))
(cmd (conc toolpath " -test " run-id "," test-id "&")))
(system cmd)))
)))))
(hash-table-set! (d:alldat-buttondat *alldat*) button-key (vector 0 "100 100 100" button-key #f #f))
(vector-set! testvec testnum butn)
(loop runnum (+ testnum 1) testvec (cons butn res))))))
;; now assemble the hdrlst and bdylst and kick off the dialog
(iup:show
(iup:dialog
#:title (conc "Megatest dashboard " (current-user-name) ":" *toppath*)
#:menu (dcommon:main-menu)
|
| ︙ | ︙ | |||
1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 |
(if (and (number? run-id)
(number? test-id)
(>= test-id 0))
(examine-test run-id test-id)
(begin
(debug:print 3 "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test"))
(exit 1)))))
((args:get-arg "-guimonitor")
(gui-monitor (d:alldat-dblocal data)))
(else
(set! uidat (make-dashboard-buttons data ;; (d:alldat-dblocal data)
(d:alldat-numruns data)
(d:alldat-num-tests data)
(d:alldat-dbkeys data)
| > > > > > > > > > > > > > > | 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 |
(if (and (number? run-id)
(number? test-id)
(>= test-id 0))
(examine-test run-id test-id)
(begin
(debug:print 3 "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test"))
(exit 1)))))
((args:get-arg "-xterm") ;; run-id,test-id
(let* ((dat (let ((d (map string->number (string-split (args:get-arg "-xterm") ","))))
(if (> (length d) 1)
d
(list #f #f))))
(run-id (car dat))
(test-id (cadr dat)))
(if (and (number? run-id)
(number? test-id)
(>= test-id 0))
(dcommon:examine-xterm run-id test-id)
(begin
(debug:print 3 "INFO: tried to open xterm with invalid run-id,test-id. " (args:get-arg "-xterm"))
(exit 1)))))
((args:get-arg "-guimonitor")
(gui-monitor (d:alldat-dblocal data)))
(else
(set! uidat (make-dashboard-buttons data ;; (d:alldat-dblocal data)
(d:alldat-numruns data)
(d:alldat-num-tests data)
(d:alldat-dbkeys data)
|
| ︙ | ︙ |
Modified dcommon.scm from [a93a40dfa1] to [6df5ef4c0d].
| ︙ | ︙ | |||
316 317 318 319 320 321 322 | (item-path (vector-ref hed 2)) (state (vector-ref hed 3)) (status (vector-ref hed 4)) (newitem (list test-name item-path (list test-id state status)))) (if (null? tal) (reverse (cons newitem res)) (loop (car tal)(cdr tal)(cons newitem res))))))) | | > > > > > > > > > > > > > > > > > > > > > > > > > > | 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 |
(item-path (vector-ref hed 2))
(state (vector-ref hed 3))
(status (vector-ref hed 4))
(newitem (list test-name item-path (list test-id state status))))
(if (null? tal)
(reverse (cons newitem res))
(loop (car tal)(cdr tal)(cons newitem res)))))))
(define (dcommon:examine-xterm run-id test-id)
(let*
((testdat (rmt:get-test-info-by-id run-id test-id)))
(if (not testdat)
(begin
(debug:print 2 "ERROR: No test data found for test " test-id ", exiting")
(exit 1))
(let*
((rundir (if testdat
(db:test-get-rundir testdat)
logfile))
(testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
(xterm (lambda ()
(if (directory-exists? rundir)
(let* ((shell (if (get-environment-variable "SHELL")
(conc "-e " (get-environment-variable "SHELL"))
""))
(command (conc "cd " rundir
";mt_xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&")))
(print "Command =" command)
(common:without-vars
command
"MT_.*"))
(message-window (conc "Directory " rundir " not found"))))))
(xterm)
(print "Adding xterm code")))))
;;======================================================================
;; D A T A T A B L E S
;;======================================================================
;; Table of keys
(define (dcommon:keys-matrix rawconfig)
|
| ︙ | ︙ |
Modified megatest.scm from [d7706449e8] to [73f0b7e955].
| ︙ | ︙ | |||
34 35 36 37 38 39 40 41 42 43 44 45 46 47 | (declare (uses launch)) (declare (uses server)) (declare (uses client)) (declare (uses tests)) (declare (uses genexample)) (declare (uses daemon)) (declare (uses db)) (declare (uses tdb)) (declare (uses mt)) (declare (uses api)) (declare (uses tasks)) ;; only used for debugging. (declare (uses env)) | > | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 | (declare (uses launch)) (declare (uses server)) (declare (uses client)) (declare (uses tests)) (declare (uses genexample)) (declare (uses daemon)) (declare (uses db)) (declare (uses dcommon)) (declare (uses tdb)) (declare (uses mt)) (declare (uses api)) (declare (uses tasks)) ;; only used for debugging. (declare (uses env)) |
| ︙ | ︙ | |||
1898 1899 1900 1901 1902 1903 1904 | (set! *client-non-blocking-mode* #t) (import extras) ;; might not be needed ;; (import csi) (import readline) (import apropos) ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ... (include "readline-fix.scm") | > > > > > | | | | | 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 | (set! *client-non-blocking-mode* #t) (import extras) ;; might not be needed ;; (import csi) (import readline) (import apropos) ;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ... (include "readline-fix.scm") (if *use-new-readline* (begin (install-history-file (get-environment-variable "HOME") ".megatest_history") ;; [homedir] [filename] [nlines]) (current-input-port (make-readline-port "megatest> "))) (begin (gnu-history-install-file-manager (string-append (or (get-environment-variable "HOME") ".") "/.megatest_history")) (current-input-port (make-gnu-readline-port "megatest> ")))) (if (args:get-arg "-repl") (repl) (load (args:get-arg "-load"))) (db:close-all dbstruct)) (exit))) (set! *didsomething* #t)))) |
| ︙ | ︙ |
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 |