Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -1019,11 +1019,11 @@ ;;====================================================================== ;; S U M M A R Y ;;====================================================================== ;; ;; General info about the run(s) and megatest area -(define (dashboard:summary data) +(define (dashboard:summary alldat) (let* ((rawconfig (read-config (conc *toppath* "/megatest.config") #f #f))) ;; changed to #f since I want #{} to be expanded by [system ...] to NOT be expanded. WAS: 'return-string))) (iup:vbox (iup:split #:value 500 (iup:frame @@ -1048,11 +1048,11 @@ ;; (iup:frame ;; #:title "Disks Areas" (dcommon:section-matrix rawconfig "disks" "Disk area" "Path")))) (iup:frame #:title "Run statistics" - (dcommon:run-stats))))) + (dcommon:run-stats alldat))))) ;;====================================================================== ;; R U N ;;====================================================================== ;; @@ -1551,11 +1551,11 @@ " -preclean -clean-cache")))) (iup:menu-item "Start xterm" #:action (lambda (obj) - (let* ((cmd (conc toolpath " -xterm " run-id "," test-id "&"))) + (let* ((cmd (conc (car (argv)) " -xterm " run-id "," test-id "&"))) (system cmd)))) (iup:menu-item "Edit testconfig" #:action (lambda (obj) @@ -1571,11 +1571,11 @@ editor) " " tconfig " &"))) (system cmd)))) )))) -(define (make-dashboard-buttons data nruns ntests keynames runs-sum-dat new-view-dat) +(define (make-dashboard-buttons alldat nruns ntests keynames runs-sum-dat new-view-dat) (let* ((nkeys (length keynames)) (runsvec (make-vector nruns)) (header (make-vector nruns)) (lftcol (make-vector ntests)) (keycol (make-vector ntests)) @@ -1584,11 +1584,11 @@ (hdrlst '()) (bdylst '()) (result '()) (i 0)) ;; controls (along bottom) - (set! controls (dboard:make-controls data)) + (set! controls (dboard:make-controls alldat)) ;; create the left most column for the run key names and the test names (set! lftlst (list (iup:hbox (iup:label) ;; (iup:valuator) (apply iup:vbox @@ -1596,11 +1596,11 @@ (let ((res (iup:hbox #:expand "HORIZONTAL" (iup:label x #:size "x15" #:fontsize "10" #:expand "HORIZONTAL") (iup:textbox #:size "x15" #:fontsize "10" #:value "%" #:expand "HORIZONTAL" #:action (lambda (obj unk val) (mark-for-update) - (update-search data x val)))))) + (update-search alldat x val)))))) (set! i (+ i 1)) res)) keynames))))) (let loop ((testnum 0) (res '())) @@ -1610,11 +1610,11 @@ (set! lftlst (append lftlst (list (iup:hbox #:expand "HORIZONTAL" (iup:valuator #:valuechanged_cb (lambda (obj) (let ((val (string->number (iup:attribute obj "VALUE"))) (oldmax (string->number (iup:attribute obj "MAX"))) (newmax (* 10 (length *alltestnamelst*)))) - (dboard:alldat-please-update-set! data #t) + (dboard:alldat-please-update-set! alldat #t) (dboard:alldat-start-test-offset-set! alldat (inexact->exact (round (/ val 10)))) (debug:print 6 *default-log-port* "(dboard:alldat-start-test-offset alldat) " (dboard:alldat-start-test-offset alldat) " val: " val " newmax: " newmax " oldmax: " oldmax) (if (< val 10) (iup:attribute-set! obj "MAX" newmax)) )) @@ -1728,11 +1728,11 @@ #:tabchangepos-cb (lambda (obj curr prev) (dboard:alldat-please-update-set! alldat #t) (dboard:alldat-curr-tab-num-set! alldat curr)) (dashboard:summary alldat) runs-view - (dashboard:one-run data runs-sum-dat) + (dashboard:one-run alldat runs-sum-dat) ;; (dashboard:new-view db data new-view-dat) (dashboard:run-controls alldat) (dashboard:run-times alldat) ))) ;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c))) @@ -1783,11 +1783,11 @@ (define *last-monitor-update-time* 0) ;; Force creation of the db in case it isn't already there. (tasks:open-db) -(define (dashboard:get-youngest-run-db-mod-time) +(define (dashboard:get-youngest-run-db-mod-time alldat) (handle-exceptions exn (begin (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn)) (current-seconds)) ;; something went wrong - just print an error and return current-seconds @@ -1794,11 +1794,11 @@ (apply max (map (lambda (filen) (file-modification-time filen)) (glob (conc (dboard:alldat-dbdir alldat) "/*.db")))))) (define (dashboard:run-update x alldat) - (let* ((modtime (dashboard:get-youngest-run-db-mod-time)) ;; (file-modification-time (dboard:alldat-dbfpath alldat))) + (let* ((modtime (dashboard:get-youngest-run-db-mod-time alldat)) ;; (file-modification-time (dboard:alldat-dbfpath alldat))) (monitor-modtime (if (file-exists? *monitor-db-path*) (file-modification-time *monitor-db-path*) -1)) (run-update-time (current-seconds)) (recalc (dashboard:recalc modtime (dboard:alldat-please-update alldat) (dboard:alldat-last-db-update alldat)))) @@ -1849,10 +1849,11 @@ (define (main) (common:exit-on-version-changed) (let* ((runs-sum-dat (dboard:alldat-make-data)) ;; init (make-d:data))) ;; data for run-summary tab (new-view-dat runs-sum-dat) ;; (dboard:alldat-make-data)) ;; init (make-d:data))) (alldat runs-sum-dat)) + (dboard:setup-alldat alldat) (dboard:setup-num-rows alldat) ;; Move this stuff to db.scm? I'm not sure that is the right thing to do... ;; (dboard:alldat-last-db-update-set! alldat (file-modification-time (dboard:alldat-dbfpath alldat))) ;; (conc *toppath* "/db/main.db"))) (set! *monitor-db-path* (conc (dboard:alldat-dbdir alldat) "/monitor.db")) (cond @@ -1920,12 +1921,12 @@ 1)))) (let ((th1 (make-thread (lambda () (thread-sleep! 1) (dboard:alldat-please-update-set! alldat #t) - (dashboard:run-update 1)) "update buttons once")) + (dashboard:run-update 1 alldat)) "update buttons once")) (th2 (make-thread iup:main-loop "Main loop"))) (thread-start! th1) (thread-start! th2) (thread-join! th2)))) (main)