Overview
Comment: | Got the tree working. Oops. Forgot that node0 was not dynamic (currently) |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
cdcc055649d29493a5bad80f8632f4fd |
User & Date: | mrwellan on 2015-06-23 08:10:32 |
Other Links: | branch diff | manifest | tags |
Context
2015-06-23
| ||
22:04 | Added ipaddr check-in: ba0aadfa06 user: mrwellan tags: v1.60 | |
08:10 | Got the tree working. Oops. Forgot that node0 was not dynamic (currently) check-in: cdcc055649 user: mrwellan tags: v1.60 | |
07:23 | Tweaks to queuefeeder check-in: ab4676a1d6 user: mrwellan tags: v1.60 | |
Changes
Modified multi-dboard.scm from [aca154a76d] to [0acf46cb12].
︙ | ︙ | |||
267 268 269 270 271 272 273 | (let* ((window-dat (hash-table-ref *windows* window-id)) (areas (data-areas window-dat)) (tabs (data-tabs window-dat)) (tab-ids (hash-table-keys tabs)) (current-tab (if (null? tab-ids) #f (hash-table-ref tabs (car tab-ids)))) | | > | > > > > > > | 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 | (let* ((window-dat (hash-table-ref *windows* window-id)) (areas (data-areas window-dat)) (tabs (data-tabs window-dat)) (tab-ids (hash-table-keys tabs)) (current-tab (if (null? tab-ids) #f (hash-table-ref tabs (car tab-ids)))) (current-tree (if (null? tab-ids) #f (tab-tree current-tab))) (seen-nodes (make-hash-table))) ;; now for each area in the window gather the data (for-each (lambda (area-name) (print "Processing for area-name " area-name) (let* ((area-dat (hash-table-ref areas area-name)) (runs (areadat-runs area-dat))) (print "Processing " area-dat " for area-name " area-name) (areadb:populate-run-info area-dat) (for-each (lambda (run-id) (let* ((run (hash-table-ref runs run-id)) (target (rundat-target run)) (runname (rundat-runname run))) (if current-tree (let* ((partial-path (append (string-split target "/")(list runname))) (full-path (cons area-name partial-path))) (if (not (hash-table-exists? seen-nodes full-path)) (begin (print "INFO: Adding node " partial-path " to section " area-name) (tree:add-node current-tree "Areas" full-path) (hash-table-set! seen-nodes full-path #t))))) )) (hash-table-keys runs)))) (hash-table-keys areas)))) (hash-table-keys *windows*))) ;;====================================================================== ;; D A S H B O A R D D B |
︙ | ︙ | |||
342 343 344 345 346 347 348 349 350 351 352 353 354 355 | ;;====================================================================== ;; <area> - <target - ... > - <runname> - <test> - <itempath - ...> (define (dashboard:tree-browser data adat window-id) ;; (iup:split (let* ((tb (iup:treebox #:selection-cb (lambda (obj id state) ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((tree-path (tree:node->path obj id)) (area (car tree-path)) (areadat-path (cdr tree-path))) #f | > > > > | 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 | ;;====================================================================== ;; <area> - <target - ... > - <runname> - <test> - <itempath - ...> (define (dashboard:tree-browser data adat window-id) ;; (iup:split (let* ((tb (iup:treebox #:value 0 #:title "Areas" #:expand "YES" #:addexpanded "NO" #:selection-cb (lambda (obj id state) ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((tree-path (tree:node->path obj id)) (area (car tree-path)) (areadat-path (cdr tree-path))) #f |
︙ | ︙ |
Modified tests/Makefile from [f77c8857a7] to [0ec8867fd3].
︙ | ︙ | |||
154 155 156 157 158 159 160 | (cd fullrun;$(MEGATEST) -preclean -runtests priority_10_waiton_1 -target $$sys/$$fs/$$dpath :runname $(RUNNAME) &);\ done;done;done test11 : cd fullrun;time (for a in 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 ;do (megatest -test-paths -target %/%/% > /dev/null ) & done; wait; ) build : ../*.scm | < > | 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 | (cd fullrun;$(MEGATEST) -preclean -runtests priority_10_waiton_1 -target $$sys/$$fs/$$dpath :runname $(RUNNAME) &);\ done;done;done test11 : cd fullrun;time (for a in 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 ;do (megatest -test-paths -target %/%/% > /dev/null ) & done; wait; ) build : ../*.scm cd ..;make -j && make install touch build cleanstart : if killall mtest -v ;then sleep 5;killall mtest -v -9;fi;true killall mtest -v;if [ ! $$? ];then sleep 5;killall mtest -v -9;fi minsetup : build mkdir -p mintest/runs mintest/links cd mintest;$(MEGATEST) -stop-server 0 cd mintest;$(MEGATEST) -server - -debug $(DEBUG) > server.log 2> server.log & sleep 3 |
︙ | ︙ |
Modified tree.scm from [02f8628298] to [1c5a9172b0].
︙ | ︙ | |||
63 64 65 66 67 68 69 | (if (> depth node-depth) ;; (+ 1 node-depth)) #f (loop hed tal depth (+ nodenum 1))))) #f)))) ;; top is the top node name zeroeth node VALUE=0 (define (tree:add-node obj top nodelst #!key (userdata #f)) | > | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | (if (> depth node-depth) ;; (+ 1 node-depth)) #f (loop hed tal depth (+ nodenum 1))))) #f)))) ;; top is the top node name zeroeth node VALUE=0 (define (tree:add-node obj top nodelst #!key (userdata #f)) (let ((curr-top (iup:attribute obj "TITLE0"))) (if (or (not (string? curr-top)) (string-null? curr-top) (string-match "^\\s*$" curr-top)) (iup:attribute-set! obj "ADDBRANCH0" top)) (cond ((not (equal? top (iup:attribute obj "TITLE0"))) (print "ERROR: top name " top " doesn't match " (iup:attribute obj "TITLE0"))) ((null? nodelst)) (else (let loop ((hed (car nodelst)) (tal (cdr nodelst)) (depth 1) (pathl (list top))) ;; Because the tree dialog changes node numbers when ;; nodes are added or removed we must look up nodes ;; each and every time. 0 is the top node so default ;; to that. (let* ((newpath (append pathl (list hed))) (parentnode (tree:find-node obj pathl)) (nodenum (tree:find-node obj newpath))) ;; Add the branch under lastnode if not found (if (not nodenum) (begin (iup:attribute-set! obj (conc "ADDBRANCH" parentnode) hed) ;; ERROR? ADDING DATA TO PARENT, DONT WE WANT IT ON CREATED NODE? (if userdata (iup:attribute-set! obj (conc "USERDATA" parentnode) userdata)) (if (null? tal) #t ;; reset to top (loop (car nodelst)(cdr nodelst) 1 (list top)))) (if (null? tal) ;; if null here then this path has already been added #t (loop (car tal)(cdr tal)(+ depth 1) newpath))))))))) (define (tree:node->path obj nodenum) (let loop ((currnode 0) (path '())) (let* ((node-depth (string->number (iup:attribute obj (conc "DEPTH" currnode)))) (node-title (iup:attribute obj (conc "TITLE" currnode))) (trimpath (if (and (not (null? path)) |
︙ | ︙ |