117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
;;======================================================================
;; T E S T S
;;======================================================================
;; Test browser
(define (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))
|
|
|
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
;;======================================================================
;; T E S T S
;;======================================================================
;; Test browser
(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))
|
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
;;======================================================================
;; R U N C O N T R O L
;;======================================================================
;; General displayer
;;
(define (area-display data adat window-id)
(let* ((view-matrix (iup:matrix
#:expand "YES"
;; #:fittosize "YES"
#:scrollbar "YES"
#:numcol 100
#:numlin 100
#:numcol-visible 3
|
|
|
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
;;======================================================================
;; R U N C O N T R O L
;;======================================================================
;; General displayer
;;
(define (dashboard:area-display data adat window-id)
(let* ((view-matrix (iup:matrix
#:expand "YES"
;; #:fittosize "YES"
#:scrollbar "YES"
#:numcol 100
#:numlin 100
#:numcol-visible 3
|
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
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
|
;;======================================================================
;; D A S H B O A R D
;;======================================================================
;; Main Panel
;;
(define (main-panel data window-id)
(iup:dialog
#:title "Megatest Control Panel"
#:menu (dcommon:main-menu data)
#:shrink "YES"
(iup:vbox
(let* ((area-names (hash-table-keys (dboard:data-cfgdat data)))
(area-panels (map (lambda (aname)
(let* ((apath (configf:lookup (dboard:data-cfgdat data) aname "path")) ;; (hash-table-ref (dboard:data-cfgdat data) area-name))
;; (hash-table-ref (dboard:data-cfgdat data) aname))
(area-dat (dashboard:init-area data aname apath))
(tb (tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data)
(ad (area-display data area-dat window-id))
(areas (dboard:data-areas data))
(dboard-dat (make-dboard:area
#f ;; tree
#f ;; matrix
area-dat ;;
#f ;; view path
'default ;; view type
#f ;; matrix
(dboard:area-tree-set! dboard-dat tb)
(dboard:area-matrix-set! dboard-dat ad)
(iup:split
#:value 200
tb ad)))
area-names))
(tabtop (apply iup:tabs area-panels)))
(let loop ((index 0)
(hed (car area-names))
(tal (cdr area-names)))
(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))))
(define (newdashboard data window-id)
(let* (;; (keys (db:get-keys *dbstruct-local* *area-dat*))
;; (runname "%")
;; (testpatt "%")
;; (keypatts (map (lambda (k)(list k "%")) keys))
;; (states '())
;; (statuses '())
(nextmintime (current-milliseconds)))
(dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data)))
;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
(iup:show (main-panel data (dboard:data-current-window-id data)))
;; Yes, running iup:show will pop up a new panel
;; (iup:show (main-panel my-window-id))
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (x)
(let ((starttime (current-milliseconds)))
;; Want to dedicate no more than 50% of the time to this so skip if
|
|
|
|
|
<
|
|
|
>
>
>
>
>
>
>
|
|
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
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
|
;;======================================================================
;; D A S H B O A R D
;;======================================================================
;; Main Panel
;;
(define (dashboard:main-panel data window-id)
(iup:dialog
#:title "Megatest Control Panel"
#:menu (dcommon:main-menu data)
#:shrink "YES"
(iup:vbox
(let* ((area-names (hash-table-keys (dboard:data-cfgdat data)))
(area-panels (map (lambda (aname)
(let* ((apath (configf:lookup (dboard:data-cfgdat data) aname "path")) ;; (hash-table-ref (dboard:data-cfgdat data) area-name))
;; (hash-table-ref (dboard:data-cfgdat data) aname))
(area-dat (dashboard:init-area data aname apath))
(tb (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data)
(ad (dashboard:area-display data area-dat window-id))
(areas (dboard:data-areas data))
(dboard-dat (make-dboard:tab
#f ;; tree
#f ;; matrix
area-dat ;;
#f ;; view path
'default ;; view type
#f ;; controls
#f ;; cached data
#f ;; filters
#f ;; the run-id
(make-hash-table) ;; run-id -> test-id, for current test id
""
)))
(hash-table-set! (dboard:data-areas data) aname dboard-dat)
(dboard:tab-tree-set! dboard-dat tb)
(dboard:tab-matrix-set! dboard-dat ad)
(iup:split
#:value 200
tb ad)))
area-names))
(tabtop (apply iup:tabs
#:tabchangepos-cb (lambda (obj curr prev)
(dboard:data-current-tab-id-set! data curr)
(dboard:data-update-needed-set! data #t)
(print "Tab is: " curr ", prev was " prev))
area-panels))
(tab-ids (dboard:data-tab-ids data)))
(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))))
(define (newdashboard data window-id)
(let* (;; (keys (db:get-keys *dbstruct-local* *area-dat*))
;; (runname "%")
;; (testpatt "%")
;; (keypatts (map (lambda (k)(list k "%")) keys))
;; (states '())
;; (statuses '())
(nextmintime (current-milliseconds)))
(dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data)))
;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application
(iup:show (dashboard:main-panel data (dboard:data-current-window-id data)))
;; Yes, running iup:show will pop up a new panel
;; (iup:show (main-panel my-window-id))
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (x)
(let ((starttime (current-milliseconds)))
;; Want to dedicate no more than 50% of the time to this so skip if
|
350
351
352
353
354
355
356
357
358
359
360
|
(let* ((window-id 0)
(groupn (or (args:get-arg "-group") "default"))
(cfname (conc (getenv "HOME") "/.megatest/" groupn ".dat"))
(cfgdat (if (file-exists? cfname)(read-config cfname (make-hash-table) #t)))
(data (make-dboard:data
cfgdat ;; this is the data from ~/.megatest for the selected group
(make-hash-table) ;; areaname -> area-rec
0
)))
(newdashboard data window-id)
(iup:main-loop))
|
|
>
>
>
|
356
357
358
359
360
361
362
363
364
365
366
367
368
369
|
(let* ((window-id 0)
(groupn (or (args:get-arg "-group") "default"))
(cfname (conc (getenv "HOME") "/.megatest/" groupn ".dat"))
(cfgdat (if (file-exists? cfname)(read-config cfname (make-hash-table) #t)))
(data (make-dboard:data
cfgdat ;; this is the data from ~/.megatest for the selected group
(make-hash-table) ;; areaname -> area-rec
0 ;; current window id
0 ;; current tab id
#f ;; redraw needed for current tab id
(make-hash-table) ;; tab-id -> areaname
)))
(newdashboard data window-id)
(iup:main-loop))
|