@@ -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)))