Megatest

Check-in [19a493addb]
Login
Overview
Comment:Parts of tree showing for first time
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 19a493addb9a9680f66bd594daf8ec00369c31f6
User & Date: matt on 2015-06-23 00:50:17
Other Links: branch diff | manifest | tags
Context
2015-06-23
07:23
Tweaks to queuefeeder check-in: ab4676a1d6 user: mrwellan tags: v1.60
00:50
Parts of tree showing for first time check-in: 19a493addb user: matt tags: v1.60
00:24
Gathered runs data check-in: 02c50a4566 user: matt tags: v1.60
Changes

Modified multi-dboard.scm from [bb378737c3] to [aca154a76d].

154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
;;
(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
  tab-ids            ;; hash of tab-id -> areaname
  )

;; 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







|







154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
;;
(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
260
261
262
263
264
265
266
267
268






269
270
271
272
273

274
275









276
277
278
279
280
281
282
	
;; initialize and refresh data
;;		
(define (dboard:general-updater con port)
  (for-each
   (lambda (window-id)
     (print "Processing for window-id " window-id)
     (let* ((window-dat (hash-table-ref *windows* window-id))
	    (areas      (data-areas     window-dat)))






       ;; 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)))

	    (print "Processing " area-dat " for area-name " area-name)
	    (areadb:populate-run-info area-dat)))









	(hash-table-keys areas))))
   (hash-table-keys *windows*)))

;;======================================================================
;; D A S H B O A R D   D B 
;;======================================================================
		







|
|
>
>
>
>
>
>




|
>

|
>
>
>
>
>
>
>
>
>







260
261
262
263
264
265
266
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
	
;; initialize and refresh data
;;		
(define (dboard:general-updater con port)
  (for-each
   (lambda (window-id)
     (print "Processing for window-id " window-id)
     (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))))
       ;; 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
		     (tree:add-node current-tree area-name (append (string-split target "/")(list runname))))
		 ))
	     (hash-table-keys runs))))
	(hash-table-keys areas))))
   (hash-table-keys *windows*)))

;;======================================================================
;; D A S H B O A R D   D B 
;;======================================================================
		
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
		      #f           ;; cached data
		      #f           ;; filters
		      #f           ;; the run-id
		      (make-hash-table) ;; run-id -> test-id, for current test id
		      ""
		      )))
    (hash-table-set! (data-areas data) aname area-dat) ;; dboard-dat)
    (hash-table-set! (data-tab-ids data) window-id dboard-dat)
    (tab-tree-set!   dboard-dat tb)
    (tab-matrix-set! dboard-dat ad)
    (iup:split
     #:value 200
     tb ad)))









|







438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
		      #f           ;; cached data
		      #f           ;; filters
		      #f           ;; the run-id
		      (make-hash-table) ;; run-id -> test-id, for current test id
		      ""
		      )))
    (hash-table-set! (data-areas data) aname area-dat) ;; dboard-dat)
    (hash-table-set! (data-tabs data) window-id dboard-dat)
    (tab-tree-set!   dboard-dat tb)
    (tab-matrix-set! dboard-dat ad)
    (iup:split
     #:value 200
     tb ad)))


448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
			     area-names))
	   (tabtop      (apply iup:tabs  
			       #:tabchangepos-cb (lambda (obj curr prev)
						   (data-current-tab-id-set! data curr)
						   (data-update-needed-set!  data #t)
						   (print "Tab is: " curr ", prev was " prev))
			       area-panels))
	   (tab-ids     (data-tab-ids data)))
      (if (not (null? area-names))
	  (let loop ((index 0)
		     (hed   (car area-names))
		     (tal   (cdr area-names)))
	    (hash-table-set! tab-ids index hed)
	    (debug:print 0 "Adding area " hed " with index " index " to dashboard")
	    (iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
	    (if (not (null? tal))
		(loop (+ index 1)(car tal)(cdr tal)))))
      tabtop))))









|




|







464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
			     area-names))
	   (tabtop      (apply iup:tabs  
			       #:tabchangepos-cb (lambda (obj curr prev)
						   (data-current-tab-id-set! data curr)
						   (data-update-needed-set!  data #t)
						   (print "Tab is: " curr ", prev was " prev))
			       area-panels))
	   (tabs     (data-tabs data)))
      (if (not (null? area-names))
	  (let loop ((index 0)
		     (hed   (car area-names))
		     (tal   (cdr area-names)))
	    ;; (hash-table-set! tabs index hed)
	    (debug:print 0 "Adding area " hed " with index " index " to dashboard")
	    (iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
	    (if (not (null? tal))
		(loop (+ index 1)(car tal)(cdr tal)))))
      tabtop))))