29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
(declare (uses tasks))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(define (control-panel db tdb keys)
(let* ((var-params (make-hash-table)) ;; register all the widgets here for querying on run, rollup, remove?
|
|
>
|
|
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
(declare (uses tasks))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(define (control-panel db tdb keys area-dat)
(let* ((toppath (megatest:area-path area-dat))
(var-params (make-hash-table)) ;; register all the widgets here for querying on run, rollup, remove?
(key-params (make-hash-table))
(monitordat '()) ;; list of monitor records
(keyentries (iup:frame
#:title "Keys"
(apply
iup:vbox
(map (lambda (key)
|
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
#:expand "YES"
#:multiline "YES"
#:font "Courier New, -10"
#:value "None..............................................."))
(lastmodtime 0)
(next-touch 0) ;; the last time the "last_update" field was updated
(refreshdat (lambda ()
(let* ((monitordbpath (conc *toppath* "/monitor.db"))
(megatestdbpath (conc *toppath* "/megatest.db"))
(modtime (max (file-modification-time megatestdbpath)
(file-modification-time monitordbpath))))
;; do stuff here when the db is updated by some other process
(if (> modtime lastmodtime)
(let ((tlst (tasks:get-tasks tdb '() '()))
(mlst (tasks:get-monitors tdb)))
(set! tasksdat tlst)
|
|
|
|
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
#:expand "YES"
#:multiline "YES"
#:font "Courier New, -10"
#:value "None..............................................."))
(lastmodtime 0)
(next-touch 0) ;; the last time the "last_update" field was updated
(refreshdat (lambda ()
(let* ((monitordbpath (conc toppath "/monitor.db"))
(megatestdbpath (conc toppath "/megatest.db"))
(modtime (max (file-modification-time megatestdbpath)
(file-modification-time monitordbpath))))
;; do stuff here when the db is updated by some other process
(if (> modtime lastmodtime)
(let ((tlst (tasks:get-tasks tdb '() '()))
(mlst (tasks:get-monitors tdb)))
(set! tasksdat tlst)
|
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
(iup:attribute-set! tabtop "TABTITLE1" "Collateral")
(iup:attribute-set! tabtop "TABTITLE2" "Fossil")
(iup:attribute-set! tabtop "TABTITLE3" "Tools")
tabtop))))
;; BUG: Remember to re-instate this!!!!
;; (on-exit (lambda ()
;; (let ((tdb (tasks:open-db)))
;; ;; (print "On-exit called")
;; (tasks:remove-monitor-record tdb)
;; (sqlite3:finalize! tdb))))
(define (gui-monitor db)
(let ((keys (db:get-keys db))
(tdb (tasks:open-db)))
(tasks:register-monitor db tdb) ;;; let the other monitors know we are here
(control-panel db tdb keys)
;(tasks:remove-monitor-record db)
;(sqlite3:finalize! db)
))
|
|
|
|
|
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
(iup:attribute-set! tabtop "TABTITLE1" "Collateral")
(iup:attribute-set! tabtop "TABTITLE2" "Fossil")
(iup:attribute-set! tabtop "TABTITLE3" "Tools")
tabtop))))
;; BUG: Remember to re-instate this!!!!
;; (on-exit (lambda ()
;; (let ((tdb (tasks:open-db area-dat)))
;; ;; (print "On-exit called")
;; (tasks:remove-monitor-record tdb)
;; (sqlite3:finalize! tdb))))
(define (gui-monitor db area-dat)
(let ((keys (db:get-keys db))
(tdb (tasks:open-db area-dat)))
(tasks:register-monitor db tdb) ;;; let the other monitors know we are here
(control-panel db tdb keys)
;(tasks:remove-monitor-record db)
;(sqlite3:finalize! db)
))
|