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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
(declare (uses bigmod.import))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses dashboard-context-menu))
(declare (uses dashboard-tests))
(declare (uses dbmod))
(declare (uses dcommon))
(declare (uses debugprint.import))
(declare (uses itemsmod))
(declare (uses launchmod))
(declare (uses mtargs))
(declare (uses mtmod))
(declare (uses mtver))
(declare (uses processmod))
(declare (uses runsmod))
(declare (uses rmtmod))
(declare (uses subrunmod))
(declare (uses tree))
(declare (uses vgmod))
(declare (uses testsmod))
(declare (uses tasksmod))
;; (declare (uses dashboard-guimonitor))
;; (declare (uses dashboard-main))
(module dashboard
*
(import (prefix iup iup:))
(import canvas-draw)
(import canvas-draw-iup)
(import ducttape-lib
bigmod)
(import (prefix sqlite3 sqlite3:)
srfi-1
chicken.file.posix
chicken.string
chicken.process-context
chicken.process-context.posix
regex regex-case srfi-69
typed-records
sparse-vectors
format
srfi-4
srfi-14
)
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "run_records.scm")
;; (include "task_records.scm")
;; (include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
;; (include "vg_records.scm")
(import debugprint
commonmod
;; gutils
configfmod
dbmod
itemsmod
launchmod
(prefix mtargs args:)
runsmod
vgmod
dcommon
tree
dashboard-context-menu
dashboard-tests
testsmod
tasksmod
|
|
>
>
>
>
>
>
>
>
>
>
>
<
|
<
|
<
|
|
<
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
>
>
>
>
>
>
<
<
>
|
|
<
<
|
|
|
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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
(declare (uses bigmod.import))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses dashboard-context-menu))
(declare (uses dashboard-tests))
(declare (uses dbmod))
(declare (uses dcommon))
;; (declare (uses debugprint.import))
(declare (uses itemsmod))
(declare (uses launchmod))
(declare (uses mtargs))
(declare (uses mtmod))
(declare (uses mtver))
(declare (uses processmod))
(declare (uses runsmod))
(declare (uses rmtmod))
(declare (uses subrunmod))
(declare (uses tree))
(declare (uses vgmod))
(declare (uses testsmod))
(declare (uses tasksmod))
;; needed for configf scripts, scheme etc.
;; (declare (uses apimod.import))
;; (declare (uses debugprint.import))
;; (declare (uses mtargs.import))
;; (declare (uses commonmod.import))
;; (declare (uses configfmod.import))
;; (declare (uses bigmod.import))
;; (declare (uses dbmod.import))
;; (declare (uses rmtmod.import))
;; ;; (declare (uses servermod.import))
;; (declare (uses launchmod.import))
;; (declare (uses dashboard-guimonitor))
;; (declare (uses dashboard-main))
(module dashboard
*
(import scheme
chicken.base
chicken.bitwise
chicken.condition
chicken.eval
chicken.file
chicken.file.posix
chicken.format
chicken.io
chicken.irregex
chicken.pathname
chicken.port
chicken.pretty-print
chicken.process
chicken.process-context
chicken.process-context.posix
chicken.process.signal
chicken.random
chicken.repl
chicken.sort
chicken.string
chicken.tcp
chicken.time
chicken.time.posix
(prefix iup iup:)
canvas-draw
canvas-draw-iup
(prefix sqlite3 sqlite3:)
srfi-1
regex regex-case srfi-69
typed-records
sparse-vectors
format
srfi-4
srfi-14
)
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "run_records.scm")
;; (include "task_records.scm")
;; (include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
;; (include "vg_records.scm")
(import (prefix mtargs args:)
;; gutils
bigmod
commonmod
configfmod
dashboard-context-menu
dashboard-tests
dbmod
dcommon
debugprint
itemsmod
launchmod
mtmod
mtver
processmod
rmtmod
runsmod
subrunmod
tasksmod
testsmod
tree
vgmod
ducttape-lib
)
(define help (conc
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright (C) Matt Welland 2012-2017
|
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
|
))
"dashboard:runs-tab-updater"))
;;======================================================================
;; The heavy lifting starts here
;;======================================================================
(define (main)
(let ((mtdb-path (conc *toppath* "/megatest.db"))) ;;
#;(if (and (common:file-exists? mtdb-path)
(file-writable? mtdb-path))
(if (not (args:get-arg "-skip-version-check"))
(common:exit-on-version-changed)))
(let* ((commondat (dboard:commondat-make)))
;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
|
|
|
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
|
))
"dashboard:runs-tab-updater"))
;;======================================================================
;; The heavy lifting starts here
;;======================================================================
(define (dashboard-main)
(let ((mtdb-path (conc *toppath* "/megatest.db"))) ;;
#;(if (and (common:file-exists? mtdb-path)
(file-writable? mtdb-path))
(if (not (args:get-arg "-skip-version-check"))
(common:exit-on-version-changed)))
(let* ((commondat (dboard:commondat-make)))
;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
|
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
|
(let ((th1 (make-thread (lambda ()
(thread-sleep! 1)
(dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab
) "update buttons once"))
(th2 (make-thread iup:main-loop "Main loop")))
(thread-start! th2)
(thread-join! th2)))))
)
(import dashboard)
;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
(if (common:file-exists? debugcontrolf)
(load debugcontrolf)))
(if (args:get-arg "-repl")
(repl)
(main))
|
>
>
>
>
>
>
>
>
>
>
>
>
|
<
|
<
<
|
|
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
|
(let ((th1 (make-thread (lambda ()
(thread-sleep! 1)
(dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab
) "update buttons once"))
(th2 (make-thread iup:main-loop "Main loop")))
(thread-start! th2)
(thread-join! th2)))))
(define (get-debugcontrolf)
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
(if (common:file-exists? debugcontrolf)
debugcontrolf
#f)))
(define (main)
(if (args:get-arg "-repl")
(repl)
(dashboard-main)))
)
(import dashboard)
;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (get-debugcontrolf)))
(load debugcontrolf))
(main)
|