Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -250,33 +250,10 @@ (define (dboard:tabdat-test-patts-set!-use vec val) (dboard:tabdat-test-patts-set! vec (if (equal? val "") #f val))) (define (dboard:tabdat-make-data) (let ((dat (make-dboard:tabdat))) - ;; curr-test-ids: (make-hash-table) - ;; command: "" - ;; dbdir: #f - ;; filters-changed: #f - ;; hide-empty-runs: #f - ;; hide-not-hide-button: #f - ;; hide-not-hide: #t - ;; key-listboxes: #f - ;; last-db-update: 0 - ;; num-tests: 15 - ;; originx: #f - ;; originy: #f - ;; path-run-ids: (make-hash-table) - ;; run-ids: (make-hash-table) - ;; run-keys: (make-hash-table) - ;; searchpatts: (make-hash-table) - ;; start-test-offset: 0 - ;; state-ignore-hash: (make-hash-table) - ;; status-ignore-hash: (make-hash-table) - ;; xadj: 0 - ;; yadj: 0 - ;; view-changed: #t - ;; ))) (dboard:setup-tabdat dat) (dboard:setup-num-rows dat) dat)) (define (dboard:setup-tabdat tabdat) @@ -2621,13 +2598,13 @@ (mutex-unlock! mtx) (dboard:tabdat-view-changed-set! tabdat #f))))) ;; doesn't work. ;; -(define (gotoescape tabdat escape) - (or (dboard:tabdat-layout-update-ok tabdat) - (escape #t))) +;;(define (gotoescape tabdat escape) +;; (or (dboard:tabdat-layout-update-ok tabdat) +;; (escape #t))) (define (dboard:graph-db-open dbstr) (let* ((parts (string-split dbstr ":")) (dbpth (if (< (length parts) 2) ;; assume then a filename was provided dbstr @@ -2738,11 +2715,10 @@ (let* ((canvas-margin 10) (not-done-runs (dboard:tabdat-not-done-runs tabdat)) (mtx (dboard:tabdat-runs-mutex tabdat)) (drawing (dboard:tabdat-drawing tabdat)) (runslib (vg:get/create-lib drawing "runslib")) ;; creates and adds lib - (layout-start (current-milliseconds)) (allruns (dboard:tabdat-allruns tabdat)) (num-runs (length allruns)) (cnv (dboard:tabdat-cnv tabdat)) (compact-layout (dboard:tabdat-compact-layout tabdat)) (row-height (if compact-layout 2 10)) @@ -2806,13 +2782,13 @@ (num-tests (length hierdat)) (tot-tests (length testsdat)) (width (* timescale run-duration)) (graph-lly (calc-y (/ -50 row-height))) (graph-uly (- (calc-y 0) canvas-margin)) + (sec-per-50pt (/ 50 timescale)) ) - ;; (print "Testing. (maptime run-start=" run-start "): " (maptime run-start) " (maptime run-end=" run-end "): " (maptime run-end) " run-duration: " run-duration) - (print "run_duration: " (seconds->hr-min-sec run-duration)) + (print "timeoffset: " timeoffset " timescale: " timescale " run-duration: " (seconds->hr-min-sec run-duration) " width: " width " sec-per-50pt: " sec-per-50pt) ;; (print "timescale: " timescale " timeoffset: " timeoffset " sizex: " sizex " originx: " originx) (mutex-lock! mtx) (vg:add-comp-to-lib runslib run-full-name runcomp) ;; Have to keep moving the instantiated box as it is anchored at the lower left ;; this should have worked for x in next statement? (maptime run-start) @@ -2893,17 +2869,19 @@ text: (db:test-get-testname (hash-table-ref tests-ht (car test-ids))) line-color: (vg:rgb->number 0 0 255 a: 128) font: "Helvetica -10")) ;; (vg:instance-move drawing run-full-name 0 (dboard:tabdat-max-row tabdat)) (dboard:tabdat-view-changed-set! tabdat #t))) ;; trigger a redraw - (if (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat) + (if (or (dboard:tabdat-layout-update-ok tabdat) + (escape #t)) ;; (dboard:tabdat-layout-update-ok tabdat) (testitemloop (car tidstal)(cdr tidstal)(+ item-num 1) new-test-objs)))))) ;; If it is an iterated test put box around it now. (if (not (null? tests-tal)) (if #f ;; (> (- (current-seconds) update-start-time) 5) (print "drawing runs taking too long") - (if (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat) + (if (or (dboard:tabdat-layout-update-ok tabdat) + (escape #t)) ;; (dboard:tabdat-layout-update-ok tabdat) (testsloop (car tests-tal)(cdr tests-tal)(+ test-num 1))))))) ;; placeholder box (dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat) 1)) ;; (let ((y (calc-y (dboard:tabdat-max-row tabdat)))) ;; (- sizey (* (dboard:tabdat-max-row tabdat) row-height)))) ;; (vg:add-obj-to-comp runcomp (vg:make-rect-obj 0 y 0 y))) @@ -2926,11 +2904,12 @@ (dboard:graph commondat tabdat tab-num -5 (+ uly 3) ulx (+ uly graph-height 3) run-start run-end timescale maptime run-full-name canvas-margin) (dboard:tabdat-max-row-set! tabdat (+ (dboard:tabdat-max-row tabdat)(quotient (+ graph-height 40 3) row-height))) ;; (vg:instance-move drawing run-full-name 0 (dboard:tabdat-max-row tabdat)) )) ;; end of the run handling loop - (if (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat) + (if (or (dboard:tabdat-layout-update-ok tabdat) + (escape #t)) ;; (dboard:tabdat-layout-update-ok tabdat) (let ((newdoneruns (cons rundat doneruns))) (if (null? runtal) (begin (dboard:rundat-data-changed-set! rundat #f) (dboard:tabdat-not-done-runs-set! tabdat '()) @@ -2940,14 +2919,14 @@ (print "drawing runs taking too long.... have " (length runtal) " remaining") ;; (dboard:tabdat-done-runs-set! tabdat newdoneruns) ;; taking too long? stop here! ;; (time (vg:draw (dboard:tabdat-drawing tabdat) #t)) (dboard:tabdat-not-done-runs-set! tabdat runtal)) (begin - (if (gotoescape tabdat escape) ;; (dboard:tabdat-layout-update-ok tabdat) + (if (or (dboard:tabdat-layout-update-ok tabdat) + (escape #t)) ;; (dboard:tabdat-layout-update-ok tabdat) (runloop (car runtal)(cdr runtal) (+ run-num 1) newdoneruns)))))))))) ;; new-run-start-row - ) - (print "Layout end: " (current-milliseconds) " delta: " (- (current-milliseconds) layout-start)))) + ))) (debug:print 2 *default-log-port* "no tabdat for run-times-tab-updater")))) (define (dashboard:runs-tab-updater commondat tab-num) (debug:catch-and-dump (lambda ()