24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
(declare (uses items))
(declare (uses db))
(declare (uses configf))
(declare (uses process))
(declare (uses launch))
(declare (uses runs))
(declare (uses dashboard-tests))
(declare (uses megatest-version))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(define help (conc
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright (C) Matt Welland 2011
Usage: dashboard [options]
-h : this help
-run runid : control run identified by runid
|
>
<
>
>
|
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
(declare (uses items))
(declare (uses db))
(declare (uses configf))
(declare (uses process))
(declare (uses launch))
(declare (uses runs))
(declare (uses dashboard-tests))
(declare (uses dashboard-guimonitor))
(declare (uses megatest-version))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(define help (conc
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright (C) Matt Welland 2011
Usage: dashboard [options]
-h : this help
-test testid : control test identified by testid
-guimonitor : control panel for runs
Misc
-rows N : set number of rows
"))
;; process args
(define remargs (args:get-args
(argv)
(list "-rows"
"-run"
"-test"
"-debug"
)
(list "-h"
"-guimonitor"
"-v"
"-q"
)
args:arg-hash
0))
(if (args:get-arg "-h")
|
457
458
459
460
461
462
463
464
465
466
467
468
469
470
|
(update-search "test-name" val)))
(iup:textbox #:size "60x15" #:fontsize "10" #:value "%"
#:action (lambda (obj unk val)
(set! *last-db-update-time* 0)
(update-search "item-name" val)))))
(iup:hbox
(iup:button "Quit" #:action (lambda (obj)(sqlite3:finalize! *db*)(exit)))
))
;; (iup:button "<- Left" #:action (lambda (obj)(set! *start-run-offset* (+ *start-run-offset* 1))))
;; (iup:button "Up ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0))))
;; (iup:button "Down v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1)))))
;; (iup:button "Right ->" #:action (lambda (obj)(set! *start-run-offset* (if (> *start-run-offset* 0)(- *start-run-offset* 1) 0))))
(iup:frame
#:title "hide"
|
>
|
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
|
(update-search "test-name" val)))
(iup:textbox #:size "60x15" #:fontsize "10" #:value "%"
#:action (lambda (obj unk val)
(set! *last-db-update-time* 0)
(update-search "item-name" val)))))
(iup:hbox
(iup:button "Quit" #:action (lambda (obj)(sqlite3:finalize! *db*)(exit)))
(iup:button "Monitor" #:action (lambda (obj)(system (conc (car (argv))" -guimonitor &"))))
))
;; (iup:button "<- Left" #:action (lambda (obj)(set! *start-run-offset* (+ *start-run-offset* 1))))
;; (iup:button "Up ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0))))
;; (iup:button "Down v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1)))))
;; (iup:button "Right ->" #:action (lambda (obj)(set! *start-run-offset* (if (> *start-run-offset* 0)(- *start-run-offset* 1) 0))))
(iup:frame
#:title "hide"
|
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
|
((args:get-arg "-test")
(let ((testid (string->number (args:get-arg "-test"))))
(if testid
(examine-test *db* testid)
(begin
(print "ERROR: testid is not a number " (args:get-arg "-test"))
(exit 1)))))
(else
(set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*))
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (x)
(run-update x)))))
;(print x)))))
(iup:main-loop)
|
>
>
|
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
|
((args:get-arg "-test")
(let ((testid (string->number (args:get-arg "-test"))))
(if testid
(examine-test *db* testid)
(begin
(print "ERROR: testid is not a number " (args:get-arg "-test"))
(exit 1)))))
((args:get-arg "-guimonitor")
(gui-monitor *db*))
(else
(set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*))
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (x)
(run-update x)))))
;(print x)))))
(iup:main-loop)
|