235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
|
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
|
-
+
-
+
|
(newstate #f)
(wtxtbox #f))
(iup:frame
#:title "Set fields"
(iup:vbox
(iup:hbox (iup:label "Comment:")
(let ((txtbox (iup:textbox #:action (lambda (val a b)
(rmt:test-set-state-status-by-id run-id test-id #f #f b)
(rmt:test-set-state-status-by-id run-id test-id #f #f b)
;; IDEA: Just set a variable with the proc to call?
(open-run-close db:test-set-state-status-by-id db test-id #f #f b)
(rmt:test-set-state-status-by-id run-id test-id #f #f b)
(set! newcomment b))
#:value (db:test-get-comment testdat)
#:expand "HORIZONTAL")))
(set! wtxtbox txtbox)
txtbox))
(apply iup:hbox
|
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
|
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
|
-
+
|
(if wtxtbox
(begin
(iup:attribute-set! wtxtbox "VALUE" c)
(if (not *dashboard-comment-share-slot*)
(set! *dashboard-comment-share-slot* wtxtbox)))
))))
(begin
(open-run-close db:test-set-state-status-by-id db test-id #f status #f)
(rmt:test-set-state-status-by-id run-id test-id #f status #f)
(db:test-set-status! testdat status))))))))
btn))
(map cadr *common:std-statuses*)))) ;; (list "PASS" "WARN" "FAIL" "CHECK" "n/a" "WAIVED" "SKIP"))))
(vector-set! *state-status* 1
(lambda (status color)
(for-each
(lambda (btn)
|
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
|
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
|
-
+
|
#:expand "HORIZONTAL"
#:action (lambda (obj)
(let ((comment (iup:attribute comnt "VALUE"))
(test-id (db:test-get-id testdat)))
(if (or (not wpatt)
(string-match wregx comment))
(begin
(open-run-close db:test-set-state-status-by-id #f test-id #f "WAIVED" comment)
(rmt:test-set-state-status-by-id run-id test-id #f "WAIVED" comment)
(db:test-set-status! testdat "WAIVED")
(cmtcmd comment)
(iup:destroy! dlog))))))
(iup:button "Cancel"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(iup:destroy! dlog)))))))
|