| ︙ | | | ︙ | |
269
270
271
272
273
274
275
276
277
278
279
280
281
282
|
(exit 1))
(let* ((run-id (if testdat (db:test-get-run_id testdat) #f))
(keydat (if testdat (open-run-close db:get-key-val-pairs #f run-id) #f))
(rundat (if testdat (open-run-close db:get-run-info #f run-id) #f))
(runname (if testdat (db:get-value-by-header (db:get-row rundat)
(db:get-header rundat)
"runname") #f))
(logfile "/this/dir/better/not/exist")
(rundir logfile)
(teststeps (if testdat (db:get-compressed-steps test-id work-area: rundir) '()))
(testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
(testname (if testdat (db:test-get-testname testdat) "n/a"))
(testmeta (if testdat
(let ((tm (open-run-close db:testmeta-get-record #f testname)))
|
>
>
|
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
|
(exit 1))
(let* ((run-id (if testdat (db:test-get-run_id testdat) #f))
(keydat (if testdat (open-run-close db:get-key-val-pairs #f run-id) #f))
(rundat (if testdat (open-run-close db:get-run-info #f run-id) #f))
(runname (if testdat (db:get-value-by-header (db:get-row rundat)
(db:get-header rundat)
"runname") #f))
;; These next two are intentional bad values to ensure errors if they should not
;; get filled in properly.
(logfile "/this/dir/better/not/exist")
(rundir logfile)
(teststeps (if testdat (db:get-compressed-steps test-id work-area: rundir) '()))
(testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ..."))
(testname (if testdat (db:test-get-testname testdat) "n/a"))
(testmeta (if testdat
(let ((tm (open-run-close db:testmeta-get-record #f testname)))
|
| ︙ | | | ︙ | |
291
292
293
294
295
296
297
298
299
300
301
302
303
304
|
"/"))
(item-path (db:test-get-item-path testdat))
(viewlog (lambda (x)
(if (file-exists? logfile)
;(system (conc "firefox " logfile "&"))
(iup:send-url logfile)
(message-window (conc "File " logfile " not found")))))
(xterm (lambda (x)
(if (directory-exists? rundir)
(let ((shell (if (get-environment-variable "SHELL")
(conc "-e " (get-environment-variable "SHELL"))
"")))
(system (conc "cd " rundir
";xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&")))
|
>
>
>
>
>
>
>
|
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
|
"/"))
(item-path (db:test-get-item-path testdat))
(viewlog (lambda (x)
(if (file-exists? logfile)
;(system (conc "firefox " logfile "&"))
(iup:send-url logfile)
(message-window (conc "File " logfile " not found")))))
(view-a-log (lambda (lfile)
(let ((lfilename (conc rundir "/" lfile)))
;; (print "lfilename: " lfilename)
(if (file-exists? lfilename)
;(system (conc "firefox " logfile "&"))
(iup:send-url lfilename)
(message-window (conc "File " lfilename " not found"))))))
(xterm (lambda (x)
(if (directory-exists? rundir)
(let ((shell (if (get-environment-variable "SHELL")
(conc "-e " (get-environment-variable "SHELL"))
"")))
(system (conc "cd " rundir
";xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&")))
|
| ︙ | | | ︙ | |
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
|
#:expand "YES"
#:scrollbar "YES"
#:numcol 6
#:numlin 30
#:numcol-visible 6
#:numlin-visible 5
#:click-cb (lambda (obj lin col status)
(if (equal? col 6)
(let ((fname (iup:attribute obj (conc lin ":" col))))
(viewlog fname)
(print "obj: " obj " lin: " lin " col: " col " status: " status)))))
))
;; (let loop ((count 0))
;; (iup:attribute-set! steps-matrix "FITTOTEXT" (conc "L" count))
;; (if (< count 30)
;; (loop (+ count 1))))
(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")
|
|
>
|
|
|
|
|
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
|
#:expand "YES"
#:scrollbar "YES"
#:numcol 6
#:numlin 30
#:numcol-visible 6
#:numlin-visible 5
#:click-cb (lambda (obj lin col status)
;; (if (equal? col 6)
(let* ((mtrx-rc (conc lin ":" 6))
(fname (iup:attribute obj mtrx-rc))) ;; col))))
(view-a-log fname)))
;; (print "obj: " obj " mtrx-rc: " mtrx-rc " fname: " fname " lin: " lin " col: " col " status: " status)))
)))
;; (let loop ((count 0))
;; (iup:attribute-set! steps-matrix "FITTOTEXT" (conc "L" count))
;; (if (< count 30)
;; (loop (+ count 1))))
(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")
|
| ︙ | | | ︙ | |
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
|
(let ((proc
(lambda (testdat)
(if (not (null? teststeps))
(let loop ((hed (car teststeps))
(tal (cdr teststeps))
(rownum 1)
(colnum 1))
(let ((val (vector-ref hed (- colnum 1))))
(iup:attribute-set! steps-matrix (conc rownum ":" colnum)(if val (conc val) ""))
(if (< colnum 6)
(loop hed tal rownum (+ colnum 1))
(if (not (null? tal))
(loop (car tal)(cdr tal)(+ rownum 1) 1))))
(iup:attribute-set! steps-matrix "REDRAW" "ALL"))))))
(hash-table-set! widgets "StepsMatrix" proc)
(proc testdat))
|
|
>
|
|
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
|
(let ((proc
(lambda (testdat)
(if (not (null? teststeps))
(let loop ((hed (car teststeps))
(tal (cdr teststeps))
(rownum 1)
(colnum 1))
(let ((val (vector-ref hed (- colnum 1)))
(mtrx-rc (conc rownum ":" colnum)))
(iup:attribute-set! steps-matrix mtrx-rc (if val (conc val) ""))
(if (< colnum 6)
(loop hed tal rownum (+ colnum 1))
(if (not (null? tal))
(loop (car tal)(cdr tal)(+ rownum 1) 1))))
(iup:attribute-set! steps-matrix "REDRAW" "ALL"))))))
(hash-table-set! widgets "StepsMatrix" proc)
(proc testdat))
|
| ︙ | | | ︙ | |