Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -34,20 +34,21 @@
debugprint.scm mtver.scm csv-xml.scm servermod.scm \
hostinfo.scm adjutant.scm processmod.scm testsmod.scm \
itemsmod.scm keysmod.scm mtmod.scm rmtmod.scm \
tasksmod.scm pgdb.scm launchmod.scm runsmod.scm \
portloggermod.scm archivemod.scm ezstepsmod.scm \
- subrunmod.scm bigmod.scm testsmod.scm
+ subrunmod.scm bigmod.scm testsmod.scm vgmod.scm
+
GUISRCF = dashboard-context-menu.scm dashboard-tests.scm \
- dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm \
- vg.scm
+ dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm
OFILES = $(SRCFILES:%.scm=%.o)
GOFILES = $(GUISRCF:%.scm=%.o)
MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o))
+
# compiled import files
MOIMPFILES = $(MSRCFILES:%.scm=%.import.o)
%.import.o : %.import.scm
csc $(CSCOPTS) -unit $*.import -c $*.import.scm -o $*.import.o
@@ -332,11 +333,13 @@
$(HELPERS) $(PREFIX)/bin/nbfake \
$(PREFIX)/bin/serialize-env \
$(PREFIX)/bin/nbfind $(PREFIX)/bin/mtrunner $(PREFIX)/bin/mt_xterm \
$(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun \
$(PREFIX)/share/db/mt-pg.sql \
- $(PREFIX)/share/js/jquery-3.1.0.slim.min.js
+ $(PREFIX)/share/js/jquery-3.1.0.slim.min.js \
+ $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard \
+ $(PREFIX)/bin/serialize-env
$(PREFIX)/bin/.$(ARCHSTR) :
mkdir -p $(PREFIX)/bin/.$(ARCHSTR)
mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib
Index: build-assist/ck5-eggs.list
==================================================================
--- build-assist/ck5-eggs.list
+++ build-assist/ck5-eggs.list
@@ -20,10 +20,11 @@
regex
regex-case
rfc3339
s11n
sha1
+simple-exceptions
slice
sparse-vectors
spiffy
spiffy-directory-listing
spiffy-request-vars
ADDED build-assist/other-stuff
Index: build-assist/other-stuff
==================================================================
--- /dev/null
+++ build-assist/other-stuff
@@ -0,0 +1,2 @@
+cd megatest/dbi;chicken-install
+
Index: dashboard-context-menu.scm
==================================================================
--- dashboard-context-menu.scm
+++ dashboard-context-menu.scm
@@ -21,30 +21,40 @@
;;======================================================================
;; implementation of context menu that pops up on
;; right click on test cell in Runs & Runs Summary Tabs
;;======================================================================
-(use format fmt)
-(require-library iup)
+(import format fmt)
(import (prefix iup iup:))
-(use canvas-draw)
+(import canvas-draw)
-(use srfi-1 posix regex regex-case srfi-69)
-(use (prefix sqlite3 sqlite3:))
+(import srfi-1
+ chicken.file.posix
+ regex regex-case srfi-69
+ (prefix sqlite3 sqlite3:))
(declare (unit dashboard-context-menu))
-(declare (uses common))
-(declare (uses db))
+(declare (uses commonmod))
+(declare (uses dbmod))
(declare (uses gutils))
-(declare (uses rmt))
-(declare (uses ezsteps))
+(declare (uses rmtmod))
+(declare (uses ezstepsmod))
;; (declare (uses sdb))
;; (declare (uses filedb))
-(declare (uses subrun))
+(declare (uses subrunmod))
+(declare (uses debugprint))
+
+(import commonmod
+ dbmod
+ rmtmod
+ ezstepsmod
+ subrunmod
+ debugprint
+ )
-(include "common_records.scm")
+;; (include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(define (dboard:launch-testpanel run-id test-id)
(let* ((dboardexe (common:find-local-megatest "dashboard"))
Index: dashboard-guimonitor.scm
==================================================================
--- dashboard-guimonitor.scm
+++ dashboard-guimonitor.scm
@@ -20,29 +20,38 @@
;;======================================================================
;; Test info panel
;;======================================================================
-(use format)
-(require-library iup)
+(import format)
(import (prefix iup iup:))
-
-(use canvas-draw)
+(import canvas-draw)
-(use sqlite3 srfi-1 posix regex regex-case srfi-69)
-(import (prefix sqlite3 sqlite3:))
+(import
+ srfi-1
+ chicken.file.posix regex regex-case srfi-69
+ (prefix sqlite3 sqlite3:))
(declare (unit dashboard-guimonitor))
-(declare (uses common))
-(declare (uses keys))
-(declare (uses db))
-(declare (uses tasks))
+(declare (uses commonmod))
+(declare (uses keysmod))
+(declare (uses dbmod))
+(declare (uses tasksmod))
+(declare (uses debugprint))
-(include "common_records.scm")
+;; (include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
+
+(import
+ commonmod
+ keysmod
+ dbmod
+ tasksmod
+ debugprint
+ )
(define (control-panel db tdb keys)
(let* ((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
Index: dashboard-tests.scm
==================================================================
--- dashboard-tests.scm
+++ dashboard-tests.scm
@@ -20,32 +20,43 @@
;;======================================================================
;; Test info panel
;;======================================================================
-(use format fmt)
-(require-library iup)
+(import format fmt)
(import (prefix iup iup:))
-(use canvas-draw)
+(import canvas-draw)
-(use srfi-1 posix regex regex-case srfi-69)
-(use (prefix sqlite3 sqlite3:))
+(import srfi-1
+ chicken.file.posix
+ regex regex-case srfi-69
+ (prefix sqlite3 sqlite3:))
(declare (unit dashboard-tests))
-(declare (uses common))
-(declare (uses db))
+(declare (uses commonmod))
+(declare (uses dbmod))
(declare (uses gutils))
-(declare (uses rmt))
-(declare (uses ezsteps))
+(declare (uses rmtmod))
+(declare (uses ezstepsmod))
;; (declare (uses sdb))
;; (declare (uses filedb))
-(declare (uses subrun))
+(declare (uses subrunmod))
+(declare (uses debugprint))
-(include "common_records.scm")
+;; (include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
+
+(import
+ commonmod
+ dbmod
+ rmtmod
+ ezstepsmod
+ subrunmod
+ debugprint
+ )
;;======================================================================
;; C O M M O N
;;======================================================================
Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -16,56 +16,77 @@
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;;
;;======================================================================
-(use format)
+(import format)
(declare (uses ducttape-lib))
-(require-library iup)
+(declare (uses bigmod))
+(declare (uses debugprint))
+
(import (prefix iup iup:))
-
(import canvas-draw)
+
;; (import canvas-draw-iup)
-(import ducttape-lib)
-(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors) ;; defstruct
-(import (prefix sqlite3 sqlite3:))
+
+(import ducttape-lib
+ bigmod)
+
+(import (prefix sqlite3 sqlite3:)
+ srfi-1
+ chicken.file.posix
+ chicken.string
+ chicken.process-context
+ regex regex-case srfi-69
+ typed-records
+ sparse-vectors)
(declare (uses commonmod))
-(declare (uses mtargs))
-;; (declare (uses keys))
-(declare (uses itemsmod))
+(declare (uses configfmod))
+(declare (uses dashboard-context-menu))
+(declare (uses dashboard-guimonitor))
+(declare (uses dashboard-tests))
(declare (uses dbmod))
-(declare (uses configfmod))
-(declare (uses process))
-(declare (uses launch))
-(declare (uses runs))
-(declare (uses dashboard-tests))
-(declare (uses dashboard-guimonitor))
+(declare (uses dcommon))
+(declare (uses itemsmod))
+(declare (uses launchmod))
+(declare (uses mtmod))
+(declare (uses mtargs))
+(declare (uses mtver))
+(declare (uses processmod))
+(declare (uses runsmod))
+(declare (uses subrunmod))
(declare (uses tree))
-(declare (uses dcommon))
-(declare (uses dashboard-context-menu))
-(declare (uses vg))
-(declare (uses subrun))
+(declare (uses vgmod))
+(declare (uses bigmod.import))
+(declare (uses debugprint.import))
;; (declare (uses dashboard-main))
-(declare (uses mt))
-(declare (uses mtver))
-(include "common_records.scm")
+;; (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 commonmod
- mtargs
- itemsmod
- dbmod
- configfmod
- )
+(import
+ commonmod
+ configfmod
+ dbmod
+ debugprint
+ itemsmod
+ launchmod
+ (prefix mtargs args:)
+ mtmod
+ mtver
+ processmod
+ runsmod
+ subrunmod
+ vgmod
+ )
(define help (conc
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright (C) Matt Welland 2012-2017
Index: dcommon.scm
==================================================================
--- dcommon.scm
+++ dcommon.scm
@@ -16,31 +16,35 @@
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;;
;;======================================================================
-(use format)
-(require-library iup)
+(import format)
+(import iup)
(import (prefix iup iup:))
(import canvas-draw)
-;; (import canvas-draw-iup)
-(use regex typed-records matchable)
+
+(import regex typed-records matchable srfi-69)
(declare (unit dcommon))
(declare (uses gutils))
-(declare (uses db))
+(declare (uses dbmod))
(declare (uses mtver))
-;; (declare (uses synchash))
+(declare (uses debugprint))
;; (include "megatest-version.scm")
-(include "common_records.scm")
+;; (include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
-(import mtver)
+(import
+ mtver
+ dbmod
+ debugprint
+ )
;; yes, this is non-ideal
(define dashboard:update-summary-tab #f)
(define dashboard:update-servers-table #f)
Index: gutils.scm
==================================================================
--- gutils.scm
+++ gutils.scm
@@ -16,15 +16,15 @@
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;;
;;======================================================================
-(require-library iup)
-(import (prefix iup iup:))
-(use canvas-draw)
+(import (prefix iup iup:)
+ canvas-draw)
-(use srfi-1 regex regex-case srfi-69)
+(import srfi-1 regex regex-case srfi-69)
+
(declare (unit gutils))
;; NOTE: These functions will move to iuputils
(define (gutils:colors-similar? color1 color2)
Index: index-tree.scm
==================================================================
--- index-tree.scm
+++ index-tree.scm
@@ -20,21 +20,22 @@
;;======================================================================
;; Tests
;;======================================================================
-(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
-(import (prefix sqlite3 sqlite3:))
+(import
+ srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils
+ (prefix sqlite3 sqlite3:))
-(declare (unit tests))
+(declare (unit testsmod))
(declare (uses lock-queue))
-(declare (uses db))
-(declare (uses common))
-(declare (uses items))
-(declare (uses runconfig))
+(declare (uses dbmod))
+(declare (uses commonmod))
+(declare (uses itemsmod))
+(declare (uses runconfigmod))
-(include "common_records.scm")
+;; (include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
Index: monitor.scm
==================================================================
--- monitor.scm
+++ monitor.scm
@@ -24,10 +24,10 @@
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
-(include "common_records.scm")
+;; (include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
Index: tree.scm
==================================================================
--- tree.scm
+++ tree.scm
@@ -29,21 +29,26 @@
(import (prefix sqlite3 sqlite3:))
(declare (unit tree))
(declare (uses mtargs))
(declare (uses mtver))
-(declare (uses launch))
+(declare (uses launchmod))
;; (declare (uses megatest-version))
(declare (uses gutils))
(declare (uses dbmod))
(declare (uses servermod))
;; (declare (uses synchash))
(declare (uses dcommon))
-(import mtver)
+(import mtver
+ launchmod
+ dbmod
+ servermod
+ )
+
;; (include "megatest-version.scm")
-(include "common_records.scm")
+;; (include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
;;======================================================================
;; T R E E S T U F F
Index: vg_records.scm
==================================================================
--- vg_records.scm
+++ vg_records.scm
@@ -17,11 +17,11 @@
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;;
-(use simple-exceptions)
+(import simple-exceptions)
(define vg:lib-exn (make-exception "wrong record type, expected vg:lib." 'assert))
(define (pmake-vg:lib . params)(let ((v (if (null? params)(make-vector 2)(apply vector 'vg:lib params)))) v))
(define (make-vg:lib #!key
(comps #f)
)
@@ -30,11 +30,11 @@
(define-inline (vg:lib-comps vec)(if (eq? (vector-ref vec 0) 'vg:lib)(vector-ref vec 1)(raise (vg:lib-exn 'vg:lib-comps 'xpr))))
(define-inline (vg:lib-comps-set! vec val)(if (eq? (vector-ref vec 0) 'vg:lib)(vector-set! vec 1 val)(raise (vg:lib-exn 'comps))))
;; Generated using make-vector-record -safe vg comp objs name file
-(use simple-exceptions)
+(import simple-exceptions)
(define vg:comp-exn (make-exception "wrong record type, expected vg:comp." 'assert))
(define (pmake-vg:comp . params)(let ((v (if (null? params)(make-vector 4)(apply vector 'vg:comp params)))) v))
(define (make-vg:comp #!key
(objs #f)
(name #f)
@@ -49,11 +49,11 @@
(define-inline (vg:comp-objs-set! vec val)(if (eq? (vector-ref vec 0) 'vg:comp)(vector-set! vec 1 val)(raise (vg:comp-exn 'objs))))
(define-inline (vg:comp-name-set! vec val)(if (eq? (vector-ref vec 0) 'vg:comp)(vector-set! vec 2 val)(raise (vg:comp-exn 'name))))
(define-inline (vg:comp-file-set! vec val)(if (eq? (vector-ref vec 0) 'vg:comp)(vector-set! vec 3 val)(raise (vg:comp-exn 'file))))
;; Generated using make-vector-record -safe vg obj type pts fill-color text line-color call-back angle font attrib extents proc
-(use simple-exceptions)
+(import simple-exceptions)
(define vg:obj-exn (make-exception "wrong record type, expected vg:obj." 'assert))
(define (pmake-vg:obj . params)(let ((v (if (null? params)(make-vector 12)(apply vector 'vg:obj params)))) v))
(define (make-vg:obj #!key
(type #f)
(pts #f)
@@ -92,11 +92,11 @@
(define-inline (vg:obj-attrib-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 9 val)(raise (vg:obj-exn 'attrib))))
(define-inline (vg:obj-extents-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 10 val)(raise (vg:obj-exn 'extents))))
(define-inline (vg:obj-proc-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 11 val)(raise (vg:obj-exn 'proc))))
;; Generated using make-vector-record -safe vg inst libname compname theta xoff yoff scalex scaley mirrx mirry call-back cache
-(use simple-exceptions)
+(import simple-exceptions)
(define vg:inst-exn (make-exception "wrong record type, expected vg:inst." 'assert))
(define (pmake-vg:inst . params)(let ((v (if (null? params)(make-vector 12)(apply vector 'vg:inst params)))) v))
(define (make-vg:inst #!key
(libname #f)
(compname #f)
@@ -135,11 +135,11 @@
(define-inline (vg:inst-mirry-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 9 val)(raise (vg:inst-exn 'mirry))))
(define-inline (vg:inst-call-back-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 10 val)(raise (vg:inst-exn 'call-back))))
(define-inline (vg:inst-cache-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 11 val)(raise (vg:inst-exn 'cache))))
;; Generated using make-vector-record -safe vg drawing libs insts scalex scaley xoff yoff cnv cache
-(use simple-exceptions)
+(import simple-exceptions)
(define vg:drawing-exn (make-exception "wrong record type, expected vg:drawing." 'assert))
(define (pmake-vg:drawing . params)(let ((v (if (null? params)(make-vector 9)(apply vector 'vg:drawing params)))) v))
(define (make-vg:drawing #!key
(libs #f)
(insts #f)
Index: vgmod.scm
==================================================================
--- vgmod.scm
+++ vgmod.scm
@@ -21,14 +21,19 @@
(declare (unit vgmod))
(module vgmod
*
-(import scheme chicken data-structures extras ports)
-(use canvas-draw iup)
-(use typed-records srfi-1 srfi-69)
-(import canvas-draw-iup)
+ (import scheme
+ chicken.base
+ chicken.bitwise
+ chicken.string
+ chicken.random
+ )
+
+(import canvas-draw iup)
+(import typed-records srfi-1 srfi-69)
(include "vg_records.scm")
;; ;; structs
;; ;;
@@ -383,20 +388,20 @@
b))
;; Obsolete function
;;
(define (vg:generate-color)
- (vg:rgb->number (random 255)
- (random 255)
- (random 255)))
+ (vg:rgb->number (pseudo-random-integer 255)
+ (pseudo-random-integer 255)
+ (pseudo-random-integer 255)))
-;; Need to return a string of random iup-color for graph
+;; Need to return a string of pseudo-random-integer iup-color for graph
;;
(define (vg:generate-color-rgb)
- (conc (number->string (random 255)) " "
- (number->string (random 255)) " "
- (number->string (random 255))))
+ (conc (number->string (pseudo-random-integer 255)) " "
+ (number->string (pseudo-random-integer 255)) " "
+ (number->string (pseudo-random-integer 255))))
(define (vg:iup-color->number iup-color)
(apply vg:rgb->number (map string->number (string-split iup-color))))
;;======================================================================