132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
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
Usage: dashboard [options]
-h : this help
|
>
>
>
>
|
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
tasksmod
testsmod
tree
vgmod
ducttape-lib
)
;; globals to dashboard module
(define *updaters-running* #f)
(define *updaters-thread* #f)
(define help (conc
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright (C) Matt Welland 2012-2017
Usage: dashboard [options]
-h : this help
|
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
|
tabdat
runnamepatt
numruns
testnamepatt
keypatts)))
(define (dashboard:runs-tab-updater commondat tab-num)
(debug:catch-and-dump
(lambda ()
(let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
(dbkeys (dboard:tabdat-dbkeys tabdat)))
(dashboard:do-update-rundat tabdat)
(let ((uidat (dboard:commondat-uidat commondat)))
(update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
))
"dashboard:runs-tab-updater"))
;;======================================================================
;; The heavy lifting starts here
;;======================================================================
(define (dashboard-main)
(let ((mtdb-path (conc *toppath* "/megatest.db"))) ;; not used for now, update for .db area and use for write access detection
|
|
|
|
|
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
|
tabdat
runnamepatt
numruns
testnamepatt
keypatts)))
(define (dashboard:runs-tab-updater commondat tab-num)
;; (debug:catch-and-dump
;; (lambda ()
(let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
(dbkeys (dboard:tabdat-dbkeys tabdat)))
(dashboard:do-update-rundat tabdat)
(let ((uidat (dboard:commondat-uidat commondat)))
(update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
))
;; "dashboard:runs-tab-updater"))
;;======================================================================
;; The heavy lifting starts here
;;======================================================================
(define (dashboard-main)
(let ((mtdb-path (conc *toppath* "/megatest.db"))) ;; not used for now, update for .db area and use for write access detection
|
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
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
|
tab-num: 1)
;; may not want this alive (manually merged it from v1.66)
(dboard:commondat-add-updater
commondat
(lambda ()
(dashboard:runs-tab-updater commondat 1))
tab-num: 2)
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (time-obj)
(let ((update-is-running #f))
(mutex-lock! (dboard:commondat-update-mutex commondat))
(set! update-is-running (dboard:commondat-updating commondat))
(if (not update-is-running)
(dboard:commondat-updating-set! commondat #t))
(mutex-unlock! (dboard:commondat-update-mutex commondat))
(if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
(begin
(dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat)
(mutex-lock! (dboard:commondat-update-mutex commondat))
(dboard:commondat-updating-set! commondat #f)
(mutex-unlock! (dboard:commondat-update-mutex commondat)))
))
1))))
(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)))
|
>
<
<
<
|
<
<
<
|
>
>
>
>
|
|
>
>
|
>
>
>
>
>
>
|
>
|
|
|
|
|
|
|
>
>
>
|
3717
3718
3719
3720
3721
3722
3723
3724
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
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
|
tab-num: 1)
;; may not want this alive (manually merged it from v1.66)
(dboard:commondat-add-updater
commondat
(lambda ()
(dashboard:runs-tab-updater commondat 1))
tab-num: 2)
(iup:callback-set! *tim*
"ACTION_CB"
(lambda (time-obj)
(if (not *updaters-thread*)
(begin
;; (debug:print-info 0 *default-log-port* "Updater started...")
(set! *updaters-thread*
(make-thread
(lambda ()
(dboard:common-run-curr-updaters commondat))))
(thread-start! *updaters-thread*))
(begin
(debug:print-info 0 *default-log-port* "Updater restarted...")
(thread-resume! *updaters-thread*)))
(thread-sleep! 0.25)
(if (eq? (thread-state *updaters-thread*) 'running)
(begin
(debug:print-info 0 *default-log-port* "Updater suspended...")
(thread-suspend! *updaters-thread*))
(begin
(set! *updaters-thread* #f)
;; (debug:print-info 0 *default-log-port* "Updater done...")
))
1))))
;; (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))
(iup:main-loop)
)))
(define (get-debugcontrolf)
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
(if (common:file-exists? debugcontrolf)
debugcontrolf
#f)))
|