114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
-
+
|
(define (update-search x val)
(hash-table-set! *searchpatts* x val))
(define (main-menu)
(iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
(iup:menu-item "Files" (iup:menu ;; Note that you can use either #:action or action: for options
(iup:menu-item "Open" action: (lambda (obj)
(show (iup:file-dialog))
(iup:show (iup:file-dialog))
(print "File->open " obj)))
(iup:menu-item "Save" #:action (lambda (obj)(print "File->save " obj)))
(iup:menu-item "Exit" #:action (lambda (obj)(exit)))))
(iup:menu-item "Tools" (iup:menu
(iup:menu-item "Create new blah" #:action (lambda (obj)(print "Tools->new blah")))
;; (iup:menu-item "Show dialog" #:action (lambda (obj)
;; (show message-window
|
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
|
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
|
-
-
-
-
+
-
-
-
-
+
-
-
-
|
;; (iup:attribute-set! mat (conc curr-row-num ":0") var)
;; (iup:attribute-set! mat (conc curr-row-num ":1") (config-lookup rawconfig fname var))
;; (set! curr-row-num (+ curr-row-num 1)))
;; (configf:section-vars rawconfig fname)))
;; (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix disks-matrix)
;; (list "setup" "jobtools" "validvalues" "env-override" "disks"))
(for-each
(lambda (mat)
(iup:attribute-set! mat "0:1" "ubuntu\nnfs\nnone")
(iup:attribute-set! mat "0:0" "Test")
(iup:attribute-set! mat "ALIGNMENT1" "ALEFT")
;; (iup:attribute-set! mat "FIXTOTEXT" "C1")
(iup:attribute-set! mat "RESIZEMATRIX" "YES")
(iup:attribute-set! mat "WIDTH1" "120")
(iup:attribute-set! mat "WIDTH0" "100")
)
(list runs-matrix))
|
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
|
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
|
+
+
-
+
-
+
-
-
+
+
|
;; 2. Update synchash to understand "get-runs", "get-tests" etc.
;; 3. Add extraction of filters to synchash calls
;;
;; Mode is 'full or 'incremental for full refresh or incremental refresh
(define (run-update keys data runname keypatts testpatt states statuses mode)
(let* (;; count and offset => #f so not used
;; the synchash calls modify the "data" hash
(get-runs-sig (conc (client:get-signature) " get-runs"))
(get-tests-sig (conc (client:get-signature) " get-tests"))
(run-changes (synchash:client-get 'db:get-runs "get-runs" (length keypatts) data runname #f #f keypatts))
(run-changes (synchash:client-get 'db:get-runs get-runs-sig (length keypatts) data runname #f #f keypatts))
;; Now can calculate the run-ids
(run-hash (hash-table-ref/default data "get-runs" #f))
(run-hash (hash-table-ref/default data get-runs-sig #f))
(run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '()))
(test-changes (synchash:client-get 'db:get-tests-for-runs "get-tests-for-runs" 0 data run-ids testpatt states statuses))
(runs-hash (hash-table-ref/default data "get-runs" #f))
(test-changes (synchash:client-get 'db:get-tests-for-runs get-tests-sig 0 data run-ids testpatt states statuses))
(runs-hash (hash-table-ref/default data get-runs-sig #f))
(header (hash-table-ref/default runs-hash "header" #f))
(run-ids (sort (filter number? (hash-table-keys runs-hash))
(lambda (a b)
(let* ((record-a (hash-table-ref runs-hash a))
(record-b (hash-table-ref runs-hash b))
(time-a (db:get-value-by-header record-a header "event_time"))
(time-b (db:get-value-by-header record-b header "event_time")))
|
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
|
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
|
-
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
+
+
|
new-test-dat))
(lambda (a b)
(let ((time-a (db:test-get-event_time a))
(time-b (db:test-get-event_time b)))
(> time-a time-b)))))
;; test-changes is a list of (( id record ) ... )
;; Get list of test names sorted by time, remove tests
(test-names (delete-duplicates (map db:test-get-testname tests)))
(test-names (delete-duplicates (map (lambda (t)
(let ((i (db:test-get-item-path t))
(n (db:test-get-testname t)))
(if (string=? i "")
(conc " " i)
n)))
tests)))
(colnum (car (hash-table-ref runid-to-col run-id))))
;; for each test name get the slot if it exists and fill in the cell
;; or take the next slot and fill in the cell, deal with items in the
;; run view panel? The run view panel can have a tree selector for
;; browsing the tests/items
;; SWITCH THIS TO USING CHANGED TESTS ONLY
(for-each (lambda (test)
(let* ((state (db:test-get-state test))
(status (db:test-get-status test))
(testname (db:test-get-testname test))
(itempath (db:test-get-item-path test))
(fullname (conc testname "/" itempath))
(dispname (if (string=? itempath "") testname (conc " " itempath)))
(rownum (hash-table-ref/default testname-to-row testname #f)))
(rownum (hash-table-ref/default testname-to-row fullname #f)))
(if (not rownum)
(let ((rownums (hash-table-values testname-to-row)))
(set! rownum (if (null? rownums)
1
(+ 1 (apply max rownums))))
(hash-table-set! testname-to-row testname rownum )
(hash-table-set! testname-to-row fullname rownum)
;; create the label
(iup:attribute-set! *runs-matrix* (conc rownum ":" 0) testname)
(iup:attribute-set! *runs-matrix* (conc rownum ":" 0) dispname)
))
;; set the cell text and color
;; (debug:print 2 "rownum:colnum=" rownum ":" colnum ", state=" status)
(iup:attribute-set! *runs-matrix* (conc rownum ":" colnum) status)
(iup:attribute-set! *runs-matrix* (conc "BGCOLOR" rownum ":" colnum) (gutils:get-color-for-state-status state status))
))
tests)))
run-ids)
|