Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -309,10 +309,14 @@
(define (seconds->time-string sec)
(time->string
(seconds->local-time sec) "%H:%M:%S"))
+(define (seconds->work-week/day sec)
+ (time->string
+ (seconds->local-time sec) "%V.%u"))
+
;;======================================================================
;; Colors
;;======================================================================
(define (common:name->iup-color name)
Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -509,14 +509,17 @@
;; Extract the various bits of data from *data* and create the command line equivalent that will be displayed
;;
(define (dashboard:update-run-command)
(let* ((cmd-tb (dboard:data-get-command-tb *data*))
(cmd (dboard:data-get-command *data*))
- (test-patt (dboard:data-get-test-patts *data*))
+ (test-patt (let ((tp (dboard:data-get-test-patts *data*)))
+ (if (equal? tp "") "%" tp)))
(states (dboard:data-get-states *data*))
(statuses (dboard:data-get-statuses *data*))
- (target (dboard:data-get-target *data*))
+ (target (let ((targ-list (dboard:data-get-target *data*)))
+ (if targ-list (string-intersperse targ-list "/") "no-target-selected")))
+ (run-name (dboard:data-get-run-name *data*))
(states-str (if (or (not states)
(null? states))
""
(conc " :state " (string-intersperse states ","))))
(statuses-str (if (or (not statuses)
@@ -526,15 +529,24 @@
(full-cmd "megatest"))
(case (string->symbol cmd)
((runtests)
(set! full-cmd (conc full-cmd
" -runtests "
- (if (equal? test-patt "") "%" test-patt) " "
+ test-patt
" -target "
- (if target (string-intersperse target "/") "no-target-selected")
+ target
" :runname "
- " somerun " ;; addme!
+ run-name
+ )))
+ ((remove-runs)
+ (set! full-cmd (conc full-cmd
+ " -remove-runs "
+ run-name
+ " -target "
+ target
+ " -testpatt "
+ test-patt
states-str
statuses-str
)))
(else (set! full-cmd " no valid command ")))
(iup:attribute-set! cmd-tb "VALUE" full-cmd)))
@@ -613,26 +625,34 @@
(set! sorted-testnames (tests:sort-by-priority-and-waiton test-records))
;; refer to *keys*, *dbkeys* for keys
(iup:vbox
;; The command line display/exectution control
- (iup:hbox
- (iup:label "Run on" #:size "40x")
- (iup:radio
- (iup:hbox
- (iup:toggle "Local" #:size "40x")
+ (iup:frame
+ #:title "Command to be exectuted"
+ (iup:hbox
+ (iup:label "Run on" #:size "40x")
+ (iup:radio
+ (iup:hbox
+ (iup:toggle "Local" #:size "40x")
(iup:toggle "Server" #:size "40x")))
- (let ((tb (iup:textbox
- #:value "megatest "
- #:expand "HORIZONTAL"
- #:readonly "YES"
- )))
- (dboard:data-set-command-tb! *data* tb)
- tb)
- (iup:button "Execute" #:size "50x"))
-
- (iup:split
+ (let ((tb (iup:textbox
+ #:value "megatest "
+ #:expand "HORIZONTAL"
+ #:readonly "YES"
+ #:font "Courier New, -12"
+ )))
+ (dboard:data-set-command-tb! *data* tb)
+ tb)
+ (iup:button "Execute" #:size "50x"
+ #:action (lambda (obj)
+ (let ((cmd (conc "xterm -geometry 180x20 -e \""
+ (iup:attribute (dboard:data-get-command-tb *data*) "VALUE")
+ ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
+ (system cmd))))))
+
+ (iup:split
#:orientation "HORIZONTAL"
(iup:split
;; Target, testpatt, state and status input boxes
#:value 300
@@ -639,12 +659,12 @@
(iup:vbox
;; Command to run
(iup:frame
#:title "Set the action to take"
(iup:hbox
- (iup:label "Command to run" #:expand "HORIZONTAL" #:size "70x" #:alignment "LEFT:ACENTER")
- (let* ((cmds-list '("runtests" "remove-runs" "set-state-status"))
+ ;; (iup:label "Command to run" #:expand "HORIZONTAL" #:size "70x" #:alignment "LEFT:ACENTER")
+ (let* ((cmds-list '("runtests" "remove-runs" "set-state-status" "lock-runs" "unlock-runs"))
(lb (iup:listbox #:expand "HORIZONTAL"
#:dropdown "YES"
#:action (lambda (obj val index lbstate)
;; (print obj " " val " " index " " lbstate)
(dboard:data-set-command! *data* val)
@@ -652,11 +672,22 @@
(default-cmd (car cmds-list)))
(iuplistbox-fill-list lb cmds-list selected-item: default-cmd)
(dboard:data-set-command! *data* default-cmd)
lb)))
(iup:frame
- #:title "Selectors that determine which tests will be operated on"
+ #:title "Runname"
+ (let* ((default-run-name (conc "ww" (seconds->work-week/day (current-seconds))))
+ (tb (iup:textbox #:expand "HORIZONTAL"
+ #:action (lambda (obj val txt)
+ ;; (print "obj: " obj " val: " val " unk: " unk)
+ (dboard:data-set-run-name! *data* txt) ;; (iup:attribute obj "VALUE"))
+ (dashboard:update-run-command))
+ #:value default-run-name)))
+ (dboard:data-set-run-name! *data* default-run-name)
+ tb))
+ (iup:frame
+ #:title "SELECTORS"
(iup:vbox
;; Text box for test patterns
(iup:frame
#:title "Test patterns (one per line)"
(iup:textbox #:action (lambda (val a b)
Index: dcommon.scm
==================================================================
--- dcommon.scm
+++ dcommon.scm
@@ -35,11 +35,11 @@
;;
;; A single data structure for all the data used in a dashboard.
;; Share this structure between newdashboard and dashboard with the
;; intent of converging on a single app.
;;
-(define *data* (make-vector 20 #f))
+(define *data* (make-vector 25 #f))
(define (dboard:data-get-runs vec) (vector-ref vec 0))
(define (dboard:data-get-tests vec) (vector-ref vec 1))
(define (dboard:data-get-runs-matrix vec) (vector-ref vec 2))
(define (dboard:data-get-tests-tree vec) (vector-ref vec 3))
(define (dboard:data-get-run-keys vec) (vector-ref vec 4))
@@ -57,10 +57,12 @@
(define (dboard:data-get-statuses vec) (vector-ref vec 14))
(define (dboard:data-get-logs-textbox vec val)(vector-ref vec 15))
(define (dboard:data-get-command vec) (vector-ref vec 16))
(define (dboard:data-get-command-tb vec) (vector-ref vec 17))
(define (dboard:data-get-target vec) (vector-ref vec 18))
+(define (dboard:data-get-run-name vec) (vector-ref vec 19))
+
(define (dboard:data-set-runs! vec val)(vector-set! vec 0 val))
(define (dboard:data-set-tests! vec val)(vector-set! vec 1 val))
(define (dboard:data-set-runs-matrix! vec val)(vector-set! vec 2 val))
(define (dboard:data-set-tests-tree! vec val)(vector-set! vec 3 val))
@@ -79,10 +81,11 @@
(define (dboard:data-set-statuses! vec val)(vector-set! vec 14 val))
(define (dboard:data-set-logs-textbox! vec val)(vector-set! vec 15 val))
(define (dboard:data-set-command! vec val)(vector-set! vec 16 val))
(define (dboard:data-set-command-tb! vec val)(vector-set! vec 17 val))
(define (dboard:data-set-target! vec val)(vector-set! vec 18 val))
+(define (dboard:data-set-run-name! vec val)(vector-set! vec 19 val))
(dboard:data-set-run-keys! *data* (make-hash-table))
;; List of test ids being viewed in various panels
(dboard:data-set-curr-test-ids! *data* (make-hash-table))