@@ -86,10 +86,15 @@ "-use-local" "-skip-version-check" ) args:arg-hash 0)) + +(if (not (null? remargs)) + (begin + (print "Unrecognised arguments: " (string-intersperse remargs " ")) + (exit))) (if (args:get-arg "-h") (begin (print help) (exit))) @@ -256,14 +261,15 @@ ((num-tests 10) : number) ;; total number of tests to show (used in the old runs display) ;; runs tree ((path-run-ids (make-hash-table)) : hash-table) ;; path (target / runname) => id (runs-tree #f) + ((runs-tree-ht (make-hash-table)) : hash-table) ;; track which targests added to tree (merge functionality with path-run-ids?) ;; tab data ((view-changed #t) : boolean) - ((rebuild-dwg #t) : boolean) + ((rebuild-dwg #f) : boolean) ((xadj 0) : number) ;; x slider number (if using canvas) ((yadj 0) : number) ;; y slider number (if using canvas) ;; runs-summary tab state ((runs-summary-modes '((one-run . "Show One Run") (xor-two-runs . "XOR Two Runs") (xor-two-runs-hide-clean . "XOR; Hide Clean")) ) : list) ((runs-summary-mode-buttons '()) : list) @@ -1174,10 +1180,11 @@ ;; (define (dashboard:update-tree-selector tabdat #!key (action-proc #f)) (let* ((tb (dboard:tabdat-runs-tree tabdat)) (runconf-targs (common:get-runconfig-targets)) (db-target-dat (rmt:get-targets)) + (runs-tree-ht (dboard:tabdat-runs-tree-ht tabdat)) (header (vector-ref db-target-dat 0)) (db-targets (vector-ref db-target-dat 1)) (munge-target (lambda (x) ;; create a target vector from a string. Pad with na if needed. (take (append (string-split x "/") (make-list (length header) "na")) @@ -1189,11 +1196,16 @@ (map munge-target runconf-targs) ))) (for-each (lambda (target) - (tree:add-node tb "Runs" target)) ;; (append key-vals (list run-name)) + (if (not (hash-table-ref/default runs-tree-ht target #f)) + ;; (let ((existing (tree:find-node tb target))) + ;; (if (not existing) + (begin + (tree:add-node tb "Runs" target) ;; (append key-vals (list run-name)) + (hash-table-set! runs-tree-ht target #t)))) all-targets))) ;; Run controls panel ;; (define (dashboard:run-controls commondat tabdat #!key (tab-num #f)) @@ -1514,24 +1526,25 @@ (let* ((run-record (hash-table-ref/default runs-hash run-id #f)) (key-vals (map (lambda (key)(db:get-value-by-header run-record runs-header key)) (dboard:tabdat-keys tabdat))) (run-name (db:get-value-by-header run-record runs-header "runname")) (col-name (conc (string-intersperse key-vals "\n") "\n" run-name)) - (run-path (append key-vals (list run-name))) - (existing (tree:find-node tb run-path))) + (run-path (append key-vals (list run-name)))) (if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f)) - (begin - (hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path) - ;; (iup:attribute-set! (dboard:tabdat-runs-matrix tabdat) - ;; (conc rownum ":" colnum) col-name) - ;; (hash-table-set! runid-to-col run-id (list colnum run-record)) - ;; Here we update the tests treebox and tree keys - (tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name)) - userdata: (conc "run-id: " run-id)) - (hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id) - ;; (set! colnum (+ colnum 1)) - )))) + ;; (let ((existing (tree:find-node tb run-path))) + ;; (if (not existing) + (begin + (hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path) + ;; (iup:attribute-set! (dboard:tabdat-runs-matrix tabdat) + ;; (conc rownum ":" colnum) col-name) + ;; (hash-table-set! runid-to-col run-id (list colnum run-record)) + ;; Here we update the tests treebox and tree keys + (tree:add-node tb "Runs" run-path) ;; (append key-vals (list run-name)) + ;; userdata: (conc "run-id: " run-id)))) + (hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id) + ;; (set! colnum (+ colnum 1)) + )))) run-ids))) (define (dashboard:tests-ht->tests-dat tests-ht) (reverse (sort @@ -2732,18 +2745,18 @@ (let* ((run-record (hash-table-ref/default runs-hash run-id #f)) (key-vals (map (lambda (key)(db:get-value-by-header run-record runs-header key)) (dboard:tabdat-keys tabdat))) (run-name (db:get-value-by-header run-record runs-header "runname")) (col-name (conc (string-intersperse key-vals "\n") "\n" run-name)) - (run-path (append key-vals (list run-name))) - (existing (tree:find-node tb run-path))) + (run-path (append key-vals (list run-name)))) + ;; (existing (tree:find-node tb run-path))) (if (not (hash-table-ref/default (dboard:tabdat-path-run-ids tabdat) run-path #f)) (begin (hash-table-set! (dboard:tabdat-run-keys tabdat) run-id run-path) ;; Here we update the tests treebox and tree keys - (tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name)) - userdata: (conc "run-id: " run-id)) + (tree:add-node tb "Runs" run-path) ;; (append key-vals (list run-name)) + ;; userdata: (conc "run-id: " run-id)) (hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id) ;; (set! colnum (+ colnum 1)) )))) run-ids)) ;; (print "Updating rundat") @@ -2763,11 +2776,10 @@ (last (dboard:tabdat-target tabdat)) "%")) (testpatt (or (dboard:tabdat-test-patts tabdat) "%")) (filtrstr (conc targpatt "/" runpatt "/" testpatt))) ;; (print "targpatt: " targpatt " runpatt: " runpatt " testpatt: " testpatt) - (print "RA => dboard:tabdat-last-filter-str " dboard:tabdat-last-filter-str "filtrstr" filtrstr "dboard:tabdat-view-changed" (dboard:tabdat-view-changed tabdat)) (if (or (not (equal? (dboard:tabdat-last-filter-str tabdat) filtrstr)) (dboard:tabdat-rebuild-dwg tabdat)) (let ((dwg (dboard:tabdat-drawing tabdat))) (print "resetting drawing") @@ -2777,11 +2789,11 @@ (vg:drawing-cache-set! dwg '()) (dboard:tabdat-allruns-by-id-set! tabdat (make-hash-table)) ;; (dboard:tabdat-allruns-set! tabdat '()) (dboard:tabdat-max-row-set! tabdat 0) (dboard:tabdat-last-filter-str-set! tabdat filtrstr) - ;; (dboard:tabdat-rebuild-dwg-set! tabdat #f) + (dboard:tabdat-rebuild-dwg-set! tabdat #f) )) (update-rundat tabdat runpatt ;; (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat) @@ -2816,11 +2828,10 @@ (mutex-lock! mtx) (canvas-clear! cnv) (vg:draw dwg tabdat) ;; RA => (dashboard:run-times-tab-run-data-updater commondat tabdat tab-num) (mutex-unlock! mtx) - (print "RA => View changed found to be set" ) (dboard:tabdat-view-changed-set! tabdat #f))))) ;; doesn't work. ;; ;;(define (gotoescape tabdat escape)