81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
-
+
|
;; (client:launch))
;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
(if (file-exists? debugcontrolf)
(load debugcontrolf)))
(define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(define *dbdir* (db:dbfile-path #f)) ;; (conc (configf:lookup configdat "setup" "linktree") "/.db"))
(define *dbstruct-local* (make-dbr:dbstruct path: *dbdir*
local: #t))
(define *db-file-path* (db:dbfile-path 0))
;; HACK ALERT: this is a hack, please fix.
(define *read-only* (not (file-read-access? *db-file-path*)))
|
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
-
+
-
+
|
(string-intersperse (map conc x) ","))
(define (update-search x val)
(hash-table-set! *searchpatts* x val))
;; mtest is actually the megatest.config file
;;
(define (mtest window-id)
(define (mtest window-id area-dat)
(let* ((curr-row-num 0)
(rawconfig (read-config (conc *toppath* "/megatest.config") #f 'return-string))
(rawconfig (read-config (conc (megatest:area-path area-dat) "/megatest.config") #f 'return-string))
(keys-matrix (dcommon:keys-matrix rawconfig))
(setup-matrix (dcommon:section-matrix rawconfig "setup" "Varname" "Value"))
(jobtools-matrix (iup:matrix
#:expand "YES"
#:numcol 1
#:numlin 5
#:numcol-visible 1
|
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
|
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
|
-
+
-
-
-
-
-
+
+
+
+
+
|
(iup:hbox))
;;======================================================================
;; D A S H B O A R D
;;======================================================================
;; Main Panel
(define (main-panel window-id)
(define (main-panel window-id area-dat)
(iup:dialog
#:title "Megatest Control Panel"
#:menu (dcommon:main-menu)
#:shrink "YES"
(let ((tabtop (iup:tabs
(runs window-id)
(tests window-id)
(runcontrol window-id)
(mtest window-id)
(rconfig window-id)
(runs window-id area-dat)
(tests window-id area-dat)
(runcontrol window-id area-dat)
(mtest window-id area-dat)
(rconfig window-id area-dat)
)))
(iup:attribute-set! tabtop "TABTITLE0" "Runs")
(iup:attribute-set! tabtop "TABTITLE1" "Tests")
(iup:attribute-set! tabtop "TABTITLE2" "Run Control")
(iup:attribute-set! tabtop "TABTITLE3" "megatest.config")
(iup:attribute-set! tabtop "TABTITLE4" "runconfigs.config")
tabtop)))
|