21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
(declare (unit dashboard-tests))
(declare (uses common))
(declare (uses db))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(define (test-info-panel testdat store-label widgets)
(iup:frame
|
>
|
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
|
(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
(declare (unit dashboard-tests))
(declare (uses common))
(declare (uses db))
(declare (uses gutils))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(define (test-info-panel testdat store-label widgets)
(iup:frame
|
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
(let ((lbl (iup:label (db:test-get-status testdat) #:expand "HORIZONTAL")))
(hash-table-set! widgets "teststatus"
(lambda (testdat)
(let ((newstatus (db:test-get-status testdat))
(oldstatus (iup:attribute lbl "TITLE")))
(if (not (equal? oldstatus newstatus))
(begin
(iup:attribute-set! lbl "FGCOLOR" (common:get-color-for-state-status (db:test-get-state testdat)
(db:test-get-status testdat)))
(iup:attribute-set! lbl "TITLE" (db:test-get-status testdat)))))))
lbl)
(store-label "testcomment"
(iup:label "TestComment "
#:expand "HORIZONTAL")
(lambda (testdat)
(db:test-get-comment testdat)))
|
|
|
|
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
(let ((lbl (iup:label (db:test-get-status testdat) #:expand "HORIZONTAL")))
(hash-table-set! widgets "teststatus"
(lambda (testdat)
(let ((newstatus (db:test-get-status testdat))
(oldstatus (iup:attribute lbl "TITLE")))
(if (not (equal? oldstatus newstatus))
(begin
(iup:attribute-set! lbl "FGCOLOR" (car (gutils:get-color-for-state-status (db:test-get-state testdat)
(db:test-get-status testdat))))
(iup:attribute-set! lbl "TITLE" (db:test-get-status testdat)))))))
lbl)
(store-label "testcomment"
(iup:label "TestComment "
#:expand "HORIZONTAL")
(lambda (testdat)
(db:test-get-comment testdat)))
|
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
|
;; use a global for setting the buttons colors
;; state status teststeps
(define *state-status* (vector #f #f #f))
(define (update-state-status-buttons testdat)
(let* ((state (db:test-get-state testdat))
(status (db:test-get-status testdat))
(color (common:get-color-for-state-status state status)))
((vector-ref *state-status* 0) state color)
((vector-ref *state-status* 1) status color)))
;;======================================================================
;; Set fields
;;======================================================================
(define (set-fields-panel test-id testdat)
|
|
|
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
;; use a global for setting the buttons colors
;; state status teststeps
(define *state-status* (vector #f #f #f))
(define (update-state-status-buttons testdat)
(let* ((state (db:test-get-state testdat))
(status (db:test-get-status testdat))
(color (car (gutils:get-color-for-state-status state status))))
((vector-ref *state-status* 0) state color)
((vector-ref *state-status* 1) status color)))
;;======================================================================
;; Set fields
;;======================================================================
(define (set-fields-panel test-id testdat)
|