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
|
(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)
;; IDEA: Just set a variable with the proc to call?
(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
(iup:label "STATE:" #:size "30x")
(let* ((btns (map (lambda (state)
(let ((btn (iup:button state
#:expand "HORIZONTAL" #:size "50x" #:font "Courier New, -10"
#:action (lambda (x)
;; (rmt:test-set-state-status-by-id run-id test-id state #f #f)
(rmt:roll-up-pass-fail-counts run-id test-id #f state #f #f) ;; test-name passed in as test-id is respected
(db:test-set-state! testdat state)))))
btn))
(map cadr *common:std-states*)))) ;; (list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "LAUNCHED" "KILLED" "KILLREQ"))))
(vector-set! *state-status* 0
(lambda (state color)
(for-each
(lambda (btn)
|
|
>
|
|
|
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
|
(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 run-id test-id #f #f b)
;; IDEA: Just set a variable with the proc to call?
;; (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
(iup:label "STATE:" #:size "30x")
(let* ((btns (map (lambda (state)
(let ((btn (iup:button state
#:expand "HORIZONTAL" #:size "50x" #:font "Courier New, -10"
#:action (lambda (x)
;; (rmt:test-set-state-status-by-id run-id test-id state #f #f)
(rmt:set-state-status-and-roll-up-items run-id test-id #f state #f #f) ;; test-name passed in as test-id is respected
(db:test-set-state! testdat state)))))
btn))
(map cadr *common:std-states*)))) ;; (list "COMPLETED" "NOT_STARTED" "RUNNING" "REMOTEHOSTSTART" "LAUNCHED" "KILLED" "KILLREQ"))))
(vector-set! *state-status* 0
(lambda (state color)
(for-each
(lambda (btn)
|
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
|
(begin
(iup:attribute-set! wtxtbox "VALUE" c)
(if (not *dashboard-comment-share-slot*)
(set! *dashboard-comment-share-slot* wtxtbox)))
))))
(begin
;; (rmt:test-set-state-status-by-id run-id test-id #f status #f)
(rmt:roll-up-pass-fail-counts run-id test-id #f #f status #f) ;; test-name passed in as test-id is respected
(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)
|
|
|
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
|
(begin
(iup:attribute-set! wtxtbox "VALUE" c)
(if (not *dashboard-comment-share-slot*)
(set! *dashboard-comment-share-slot* wtxtbox)))
))))
(begin
;; (rmt:test-set-state-status-by-id run-id test-id #f status #f)
(rmt:set-state-status-and-roll-up-items run-id test-id #f #f status #f) ;; test-name passed in as test-id is respected
(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)
|
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
|
#: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
(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)))))))
|
|
>
|
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
|
#: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
;; (rmt:test-set-state-status-by-id run-id test-id #f "WAIVED" comment)
(rmt:test-set-state-status-by 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)))))))
|