Index: configf.scm
==================================================================
--- configf.scm
+++ configf.scm
@@ -40,10 +40,16 @@
(define (config:assoc-safe-add alist key val #!key (metadata #f))
(let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
(append newalist (list (if metadata
(list key val metadata)
(list key val))))))
+
+
+(define (configf:set-section-var cfgdat section var value)
+ (let ((sect (hash-table-ref/default cfgdat section '())))
+ (hash-table-set! cfgdat section (config:assoc-safe-add sect var value))))
+
(define (config:eval-string-in-environment str)
(handle-exceptions
exn
(begin
@@ -596,5 +602,7 @@
(fname (if (> (length dat-pair) 2)(caddr dat-pair) #f)))
(if fname (print "# " var "=>" fname))
(print var " " val)))
section-dat))) ;; (print "section-dat: " section-dat))
(hash-table->alist data)))
+
+
Index: multi-dboard.scm
==================================================================
--- multi-dboard.scm
+++ multi-dboard.scm
@@ -163,10 +163,11 @@
areas ;; hash of areaname -> area-rec
current-window-id ;;
current-tab-id ;;
update-needed ;; flag to indicate that the tab pointed to by current tab id needs refreshing immediately
tabs ;; hash of tab-id -> areaname (??) should be of type "tab"
+ groupn ;;
)
;; all the components of an area display, all fits into a tab but
;; parts may be swapped in/out as needed
;;
@@ -412,16 +413,26 @@
(view-matrix (iup:matrix
;; (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f))
#:expand "YES"
;; #:fittosize "YES"
#:resizematrix "YES"
+ #:menucontext "YES"
#:scrollbar "YES"
#:numcol 100
#:numlin 100
#:numcol-visible 3
#:numlin-visible 20
#:click-cb (lambda (obj lin col status)
+ (let ((popup-menu (iup:menu
+ (iup:menu-item "Remove test"
+ #:action (lambda (obj)(print "Removing test"))))))
+ (iup:show popup-menu
+ #:x 'mouse
+ #:y 'mouse
+ #:modal? "NO")
+
+ (print "got here"))
(print "obj: " obj " lin: " lin " col: " col " status: " status " value: " (iup:attribute obj "VALUE"))))))
;; (iup:attribute-set! view-matrix "RESIZEMATRIX" "YES")
(iup:attribute-set! view-matrix "WIDTH0" "100")
;; (dboard:data-set-runs-matrix! *data* runs-matrix)
@@ -517,10 +528,48 @@
;;======================================================================
;; D A S H B O A R D
;;======================================================================
+
+;; The main menu
+(define (dcommon:main-menu data)
+ (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)
+ (let* ((area-name (iup:textbox #:expand "HORIZONTAL"))
+ (fd (iup:file-dialog #:dialogtype "DIR"))
+ (top (iup:show fd #:modal? "YES")))
+ (iup:attribute-set! source-tb "VALUE"
+ (iup:attribute fd "VALUE"))
+ (iup:destroy! fd))))
+ (iup:menu-item "Open area" action: (lambda (obj)
+ (let* ((area-name (iup:textbox #:expand "HORIZONTAL"))
+ (fd (iup:file-dialog #:dialogtype "DIR"))
+ (top (iup:show fd #:modal? "YES"))
+ ;;(source-tb (iup:textbox #:expand "HORIZONTAL"))
+ (cfgdat (data-cfgdat data))
+ (fname (conc (getenv "HOME") "/.megatest/" (data-groupn data) ".dat"))
+ )
+ ;;(iup:attribute-set! source-tb "VALUE"
+ ;; (iup:attribute fd "VALUE"))
+ (configf:set-section-var cfgdat "lvqa" "path" (iup:attribute fd "VALUE"))
+ (configf:write-alist cfgdat fname)
+ (iup:destroy! fd))))
+ (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 (dashboard:area-panel aname data window-id)
(let* ((apath (configf:lookup (data-cfgdat data) aname "path")) ;; (hash-table-ref (dboard:data-cfgdat data) area-name))
;; (hash-table-ref (dboard:data-cfgdat data) aname))
(area-dat (dashboard:init-area data aname apath))
@@ -554,11 +603,11 @@
;; Main Panel
;;
(define (dashboard:main-panel data window-id)
(iup:dialog
#:title "Megatest Control Panel"
-;; #:menu (dcommon:main-menu data)
+ #:menu (dcommon:main-menu data)
#:shrink "YES"
(iup:vbox
(let* ((area-names (hash-table-keys (data-cfgdat data)))
(area-panels (map (lambda (aname)
(dashboard:area-panel aname data window-id))
@@ -749,13 +798,17 @@
(define (dboard:read-mtconf apath)
(let* ((mtconffile (conc apath "/megatest.config")))
(call-with-environment-variables
(list (cons "MT_RUN_AREA_HOME" apath))
(lambda ()
- (read-config mtconffile (make-hash-table) #f)) ;; megatest.config
- )))
-
+ (let ((res (read-config mtconffile (make-hash-table) #f))) ;; megatest.config
+ (if (hash-table? res)
+ res
+ (begin
+ (debug:print 0 "WARNING: failed to read " mtconffile)
+ (make-hash-table))))))))
+
;;======================================================================
;; G U I S T U F F
;;======================================================================
@@ -771,13 +824,15 @@
(make-hash-table) ;; areaname -> area-rec
0 ;; current window id
0 ;; current tab id
#f ;; redraw needed for current tab id
(make-hash-table) ;; tab-id -> areaname
+ groupn
)))
(hash-table-set! *windows* window-id data)
(iup:show (dashboard:main-panel data window-id))
+ ;;(iup:show (layout-dialog (dashboard:main-panel data window-id)))
(iup:main-loop)))
;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
(if (file-exists? debugcontrolf)
Index: tests/fullrun/multi-dboard.sh
==================================================================
--- tests/fullrun/multi-dboard.sh
+++ tests/fullrun/multi-dboard.sh
@@ -14,11 +14,11 @@
# EOF
# fi
if [[ ! -e "$HOME/.megatest/default.dat" ]];then
cat > "$HOME/.megatest/default.dat" << EOF
[fullrun]
-path /mfs/matt/data/megatest/tests/fullrun
+path /p/fdk/gwa/ritikaag/megatest/tests/fullrun
order 1
# [bigrun]
# path /mfs/matt/data/megatest/tests/fdktestqa/testqa
# order 2
# [local_fullrun]
@@ -25,6 +25,6 @@
# path /home/matt/data/megatest/tests/fullrun
# order 3
EOF
fi
-csi -I ../.. multi-dboard-load-all.scm
+/nfs/pdx/disks/icf_external/pkgs/chicken/4.10.0/bin/csi -I ../.. multi-dboard-load-all.scm