1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(use format)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
|
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(use format numbers)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
|
| ︙ | | | ︙ | |
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
|
#:expand "YES"
#:numcol 1
#:numlin 5
#:numcol-visible 1
#:numlin-visible 5))
(steps-matrix (iup:matrix
#:expand "YES"
#:numcol 5
#:numlin 50
#:numcol-visible 5
#:numlin-visible 8))
(data-matrix (iup:matrix
#:expand "YES"
#:numcol 8
#:numlin 50
#:numcol-visible 8
#:numlin-visible 8))
|
|
|
|
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
|
#:expand "YES"
#:numcol 1
#:numlin 5
#:numcol-visible 1
#:numlin-visible 5))
(steps-matrix (iup:matrix
#:expand "YES"
#:numcol 6
#:numlin 50
#:numcol-visible 6
#:numlin-visible 8))
(data-matrix (iup:matrix
#:expand "YES"
#:numcol 8
#:numlin 50
#:numcol-visible 8
#:numlin-visible 8))
|
| ︙ | | | ︙ | |
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
|
;; Steps matrix
(iup:attribute-set! steps-matrix "0:1" "Step Name")
(iup:attribute-set! steps-matrix "0:2" "Start")
(iup:attribute-set! steps-matrix "0:3" "End")
(iup:attribute-set! steps-matrix "WIDTH3" "50")
(iup:attribute-set! steps-matrix "0:4" "Status")
(iup:attribute-set! steps-matrix "WIDTH4" "50")
(iup:attribute-set! steps-matrix "0:5" "Log File")
(iup:attribute-set! steps-matrix "ALIGNMENT1" "ALEFT")
;; (iup:attribute-set! steps-matrix "FIXTOTEXT" "C1")
(iup:attribute-set! steps-matrix "RESIZEMATRIX" "YES")
;; (iup:attribute-set! steps-matrix "WIDTH1" "120")
;; (iup:attribute-set! steps-matrix "WIDTH0" "100")
;; Data matrix
|
|
>
|
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
|
;; Steps matrix
(iup:attribute-set! steps-matrix "0:1" "Step Name")
(iup:attribute-set! steps-matrix "0:2" "Start")
(iup:attribute-set! steps-matrix "0:3" "End")
(iup:attribute-set! steps-matrix "WIDTH3" "50")
(iup:attribute-set! steps-matrix "0:4" "Status")
(iup:attribute-set! steps-matrix "WIDTH4" "50")
(iup:attribute-set! steps-matrix "0:5" "Duration")
(iup:attribute-set! steps-matrix "0:6" "Log File")
(iup:attribute-set! steps-matrix "ALIGNMENT1" "ALEFT")
;; (iup:attribute-set! steps-matrix "FIXTOTEXT" "C1")
(iup:attribute-set! steps-matrix "RESIZEMATRIX" "YES")
;; (iup:attribute-set! steps-matrix "WIDTH1" "120")
;; (iup:attribute-set! steps-matrix "WIDTH0" "100")
;; Data matrix
|
| ︙ | | | ︙ | |
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
|
;; The function to update the fields in the test view panel
(define (test-update window-id testdat run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix steps-matrix data-matrix)
;; get test-id
;; then get test record
(if testdat
(let* ((test-id (hash-table-ref/default (dboard:data-get-curr-test-ids *data*) window-id #f))
(test-data (hash-table-ref/default testdat test-id #f))
(targ/runname (hash-table-ref/default (dboard:data-get-run-keys *data*)
(db:test-get-run_id test-data) '()))
(target (if (null? targ/runname) "" (string-intersperse (reverse (cdr (reverse targ/runname))) "/")))
(runname (if (null? targ/runname) "" (car (cdr targ/runname)))))
(if test-data
(begin
;;
(for-each
(lambda (data)
(let ((mat (car data))
(vals (cadr data))
|
>
>
|
|
>
>
|
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
|
;; The function to update the fields in the test view panel
(define (test-update window-id testdat run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix steps-matrix data-matrix)
;; get test-id
;; then get test record
(if testdat
(let* ((test-id (hash-table-ref/default (dboard:data-get-curr-test-ids *data*) window-id #f))
(test-data (hash-table-ref/default testdat test-id #f))
(run-id (db:test-get-run_id test-data))
(targ/runname (hash-table-ref/default (dboard:data-get-run-keys *data*)
run-id
'()))
(target (if (null? targ/runname) "" (string-intersperse (reverse (cdr (reverse targ/runname))) "/")))
(runname (if (null? targ/runname) "" (car (cdr targ/runname))))
(steps-dat (dcommon:get-compressed-steps *dbstruct-local* run-id test-id)))
(if test-data
(begin
;;
(for-each
(lambda (data)
(let ((mat (car data))
(vals (cadr data))
|
| ︙ | | | ︙ | |
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
|
(if test-id
(list (db:test-get-host test-data)
(db:test-get-uname test-data)
(db:test-get-diskfree test-data)
(db:test-get-cpuload test-data)
(seconds->hr-min-sec (db:test-get-run_duration test-data)))
(make-list 5 "")))
;;(list meta-dat-matrix
;; (if test-id
;; (list (
)))))))
|
>
>
<
|
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
|
(if test-id
(list (db:test-get-host test-data)
(db:test-get-uname test-data)
(db:test-get-diskfree test-data)
(db:test-get-cpuload test-data)
(seconds->hr-min-sec (db:test-get-run_duration test-data)))
(make-list 5 "")))
))
(dcommon:populate-steps steps-dat steps-matrix))))))
;;(list meta-dat-matrix
;; (if test-id
;; (list (
;; db:test-get-id
;; db:test-get-run_id
;; db:test-get-testname
;; db:test-get-state
;; db:test-get-status
|
| ︙ | | | ︙ | |