| ︙ | | |
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
+
|
(declare (uses runsmod))
(declare (uses rmtmod))
(declare (uses subrunmod))
(declare (uses tree))
(declare (uses vgmod))
(declare (uses testsmod))
(declare (uses tasksmod))
(declare (uses dbi))
;; 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))
|
| ︙ | | |
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
+
|
chicken.time
chicken.time.posix
(prefix iup iup:)
canvas-draw
canvas-draw-iup
(prefix sqlite3 sqlite3:)
(prefix dbi dbi:)
srfi-1
regex regex-case srfi-69
typed-records
sparse-vectors
format
srfi-4
srfi-14
|
| ︙ | | |
236
237
238
239
240
241
242
243
244
245
246
247
248
249
|
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
+
|
;; RA => Might require revert for filters
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn")
(thread-start! (make-thread common:watchdog "Watchdog thread"))
;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn")
;; (if (not (args:get-arg "-use-db-cache"))
;; (begin
;; (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
;; (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;)
;;)
|
| ︙ | | |
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
|
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
|
-
+
|
(apply iup:hbox (reverse hdrlst))
(apply iup:hbox (reverse bdylst))
(dashboard:runs-horizontal-slider runs-dat))))
controls
))
(views-cfgdat (common:load-views-config))
(additional-tabnames '())
(tab-start-num 5) ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW
(tab-start-num 6) ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW
;; (data (dboard:tabdat-init (make-d:data)))
(additional-views ;; process views-dat
(let ((tab-num tab-start-num)
(result '()))
(for-each
(lambda (view-name)
(debug:print 0 *default-log-port* "Adding view " view-name)
|
| ︙ | | |
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
|
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
|
+
+
+
|
"tabchangepos"))
(dashboard:summary commondat stats-dat tab-num: 0)
runs-view
;; (make-runs-view commondat runs2-dat 2)
(dashboard:runs-summary commondat onerun-dat tab-num: 2)
(dashboard:run-controls commondat runcontrols-dat tab-num: 3)
(dashboard:run-times commondat runtimes-dat tab-num: 4)
(iup:vbox (iup:button "Pushme")) ;; tab 5
additional-views)))
;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
(iup:attribute-set! tabs "TABTITLE0" "Summary")
(iup:attribute-set! tabs "TABTITLE1" "Runs")
;; (iup:attribute-set! tabs "TABTITLE2" "Runs2")
(iup:attribute-set! tabs "TABTITLE2" "Run Summary")
(iup:attribute-set! tabs "TABTITLE3" "Run Control")
(iup:attribute-set! tabs "TABTITLE4" "Run Times")
(iup:attribute-set! tabs "TABTITLE5" "Sys Status")
;; (iup:attribute-set! tabs "TABTITLE3" "New View")
;; (iup:attribute-set! tabs "TABTITLE4" "Run Control")
;; set the tab names for user added tabs
(for-each
(lambda (tab-info)
(iup:attribute-set! tabs (conc "TABTITLE" (car tab-info)) (cdr tab-info)))
|
| ︙ | | |
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
|
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
|
-
+
|
"dashboard:runs-tab-updater"))
;;======================================================================
;; The heavy lifting starts here
;;======================================================================
(define (dashboard-main)
(let ((mtdb-path (conc *toppath* "/megatest.db"))) ;;
(let ((mtdb-path (conc *toppath* "/megatest.db"))) ;; not used for now, update for .db area and use for write access detection
#;(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...
(cond
|
| ︙ | | |