Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -5,11 +5,11 @@ SRCFILES = common.scm items.scm launch.scm \ ods.scm runconfig.scm server.scm configf.scm \ db.scm keys.scm margs.scm megatest-version.scm \ process.scm runs.scm tasks.scm tests.scm -GUISRCF = dashboard.scm dashboard-tests.scm dashboard-guimonitor.scm +GUISRCF = dashboard.scm dashboard-tests.scm dashboard-guimonitor.scm dashboard-main.scm OFILES = $(SRCFILES:%.scm=%.o) GOFILES = $(GUISRCF:%.scm=%.o) HELPERS=$(addprefix $(PREFIX)/bin/,mt_laststep mt_runstep mt_ezstep) @@ -21,12 +21,12 @@ dboard : $(OFILES) $(GOFILES) csc $(OFILES) $(GOFILES) -o dboard # Special dependencies for the includes -tests.o db.o launch.o runs.o dashboard-tests.o dashboard-guimonitor.o monitor.o dashboard.o megatest.o : db_records.scm -tests.o runs.o dashboard.o dashboard-tests.o : run_records.scm +tests.o db.o launch.o runs.o dashboard-tests.o dashboard-guimonitor.o dashboard-main.o monitor.o dashboard.o megatest.o : db_records.scm +tests.o runs.o dashboard.o dashboard-tests.o dashboard-main.o : run_records.scm db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm tests.o tasks.o dashboard-tasks.o : task_records.scm runs.o : test_records.scm $(OFILES) $(GOFILES) : common_records.scm Index: dashboard-main.scm ================================================================== --- dashboard-main.scm +++ dashboard-main.scm @@ -20,11 +20,11 @@ (use canvas-draw) (use sqlite3 srfi-1 posix regex regex-case srfi-69) (import (prefix sqlite3 sqlite3:)) -(declare (unit dashboard-guimonitor)) +(declare (unit dashboard-main)) (declare (uses common)) (declare (uses keys)) (declare (uses db)) (declare (uses tasks)) @@ -32,31 +32,155 @@ (include "db_records.scm") (include "run_records.scm") (include "task_records.scm") (define (main-menu) - (menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top) - (menu-item "Files" (menu ;; Note that you can use either #:action or action: for options - (menu-item "Open" action: (lambda (obj) - (show (file-dialog)) - (print "File->open " obj))) - (menu-item "Save" #:action (lambda (obj)(print "File->save " obj))) - (menu-item "Exit" #:action (lambda (obj)(exit))))) - (menu-item "Tools" (menu - (menu-item "Create new blah" #:action (lambda (obj)(print "Tools->new blah"))) - (menu-item "Show dialog" #:action (lambda (obj) - (show message-window - #:modal? #t - ;; set positon using coordinates or center, start, top, left, end, bottom, right, parent-center, current - ;; #:x 'mouse - ;; #:y 'mouse - ))))))) -(define (main-panel mtest rconfig tests runs) - (dialog + (iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top) + (iup:menu-item "Files" (iup:menu ;; Note that you can use either #:action or action: for options + (iup:menu-item "Open" action: (lambda (obj) + (show (iup:file-dialog)) + (print "File->open " obj))) + (iup:menu-item "Save" #:action (lambda (obj)(print "File->save " obj))) + (iup:menu-item "Exit" #:action (lambda (obj)(exit))))) + (iup:menu-item "Tools" (iup:menu + (iup:menu-item "Create new blah" #:action (lambda (obj)(print "Tools->new blah"))) + ;; (iup:menu-item "Show dialog" #:action (lambda (obj) + ;; (show message-window + ;; #:modal? #t + ;; ;; set positon using coordinates or center, start, top, left, end, bottom, right, parent-center, current + ;; ;; #:x 'mouse + ;; ;; #:y 'mouse + ;; ) + )))) + + +(define (mtest) + (let* ((curr-row-num 0) + (rawconfig (read-config (conc *toppath* "/megatest.config") #f 'return-string)) + (keys-matrix (iup:matrix + #:expand "YES" + ;; #:scrollbar "YES" + #:numcol 1 + #:numlin 20 + #:numcol-visible 1 + #:numlin-visible 5 + #:click-cb (lambda (obj lin col status) + (print "obj: " obj " lin: " lin " col: " col " status: " status)))) + (setup-matrix (iup:matrix + #:expand "YES" + #:numcol 1 + #:numlin 5 + #:numcol-visible 1 + #:numlin-visible 3)) + (jobtools-matrix (iup:matrix + #:expand "YES" + #:numcol 1 + #:numlin 5 + #:numcol-visible 1 + #:numlin-visible 3)) + (validvals-matrix (iup:matrix + #:expand "YES" + #:numcol 1 + #:numlin 5 + #:numcol-visible 1 + #:numlin-visible 2)) + (envovrd-matrix (iup:matrix + #:expand "YES" + #:numcol 1 + #:numlin 20 + #:numcol-visible 1 + #:numlin-visible 8)) + (disks-matrix (iup:matrix + #:expand "YES" + #:numcol 1 + #:numlin 20 + #:numcol-visible 1 + #:numlin-visible 8))) + (iup:attribute-set! keys-matrix "0:0" "Field Num") + (iup:attribute-set! keys-matrix "0:1" "Field Name") + (for-each + (lambda (mat) + (iup:attribute-set! mat "0:1" "Value") + (iup:attribute-set! mat "0:0" "Var") + (iup:attribute-set! mat "ALIGNMENT1" "ALEFT") + (iup:attribute-set! mat "FIXTOTEXT" "C1") + (iup:attribute-set! mat "RESIZEMATRIX" "YES")) + (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix)) + (iup:attribute-set! disks-matrix "0:0" "Disk Name") + (iup:attribute-set! disks-matrix "0:1" "Disk Path") + (iup:attribute-set! disks-matrix "ALIGNMENT1" "ALEFT") + (iup:attribute-set! disks-matrix "FIXTOTEXT" "C1") + (iup:attribute-set! disks-matrix "RESIZEMATRIX" "YES") + ;; fill in keys + (set! curr-row-num 1) + (for-each + (lambda (var) + (iup:attribute-set! keys-matrix (conc curr-row-num ":0") curr-row-num) + (iup:attribute-set! keys-matrix (conc curr-row-num ":1") var) + (set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var))) + (configf:section-vars rawconfig "fields")) + + ;; fill in existing info + (for-each + (lambda (mat fname) + (set! curr-row-num 1) + (for-each + (lambda (var) + (iup:attribute-set! mat (conc curr-row-num ":0") var) + (iup:attribute-set! mat (conc curr-row-num ":1") (config-lookup rawconfig fname var)) + (set! curr-row-num (+ curr-row-num 1))) + (configf:section-vars rawconfig fname))) + (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix disks-matrix) + (list "setup" "jobtools" "validvalues" "env-override" "disks")) + + (iup:vbox + (iup:hbox + ;; The keys + (iup:frame + #:title "Keys" + keys-matrix) + (iup:vbox + ;; The setup section + (iup:frame + #:title "Setup" + setup-matrix) + ;; The jobtools + (iup:frame + #:title "Jobtools" + jobtools-matrix) + ;; The valid values + (iup:frame + #:title "Validvalues" + validvals-matrix)) + (iup:vbox + ;; The Environment Overrides + (iup:frame + #:title "Env override" + envovrd-matrix) + ;; The disks + (iup:frame + #:title "Disks" + disks-matrix)) + )))) + +(define (rconfig) + (iup:vbox + (iup:frame #:title "Default"))) + +(define (tests) + (iup:hbox + (iup:frame #:title "Tests browser"))) + +(define (runs) + (iup:hbox + (iup:frame #:title "Runs browser"))) + +(define (main-panel) + (iup:dialog #:title "Menu Test" #:menu (main-menu) - (let ((tabtop (iup:tabs mtest rconfig tests runs))) + (let ((tabtop (iup:tabs (mtest) (rconfig) (tests) (runs)))) (iup:attribute-set! tabtop "TABTITLE0" "Megatest") (iup:attribute-set! tabtop "TABTITLE1" "Runconfigs") (iup:attribute-set! tabtop "TABTITLE2" "Tests") (iup:attribute-set! tabtop "TABTITLE3" "Runs") tabtop))) Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -27,10 +27,11 @@ (declare (uses process)) (declare (uses launch)) (declare (uses runs)) (declare (uses dashboard-tests)) (declare (uses dashboard-guimonitor)) +(declare (uses dashboard-main)) (declare (uses megatest-version)) (include "common_records.scm") (include "db_records.scm") (include "run_records.scm") @@ -57,10 +58,11 @@ "-test" "-debug" ) (list "-h" "-guimonitor" + "-main" "-v" "-q" ) args:arg-hash 0)) @@ -700,14 +702,16 @@ (begin (print "ERROR: testid is not a number " (args:get-arg "-test")) (exit 1))))) ((args:get-arg "-guimonitor") (gui-monitor *db*)) + ((args:get-arg "-main") + (iup:show (main-panel))) (else (set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*)) (iup:callback-set! *tim* "ACTION_CB" (lambda (x) (run-update x))))) ;(print x))))) (iup:main-loop)