@@ -215,10 +215,11 @@ ((args:get-arg "-use-local") #f) ((configf:lookup *configdat* "dashboard" "use-server") (let ((ans (config:lookup *configdat* "dashboard" "use-server"))) (if (equal? ans "yes") #t #f))) (else #t))) +(define *dashboard-mode* (string->symbol (or (configf:lookup *configdat* "dashboard" "mode") "dashboard"))) (d:alldat-dbdir-set! *alldat* (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) (d:alldat-dblocal-set! *alldat* (make-dbr:dbstruct path: (d:alldat-dbdir *alldat*) local: #t)) (d:alldat-dbfpath-set! *alldat* (db:dbfile-path 0)) @@ -349,20 +350,22 @@ sort-by sort-order 'shortlist (if (d:alldat-filters-changed data) 0 - last-update)) + last-update) + *dashboard-mode*) ;; use dashboard mode (db:get-tests-for-run (d:alldat-dblocal data) run-id testnamepatt states statuses #f #f (d:alldat-hide-not-hide data) sort-by sort-order 'shortlist (if (d:alldat-filters-changed data) 0 - last-update)))) + last-update) + *dashboard-mode*))) (tests (let ((newdat (filter (lambda (x) (not (equal? (db:test-get-state x) "DELETED"))) ;; remove deleted tests but do it after merging (delete-duplicates (if (d:alldat-filters-changed data) tmptests @@ -401,18 +404,20 @@ ;; NOTE: bubble-up also sets the global (d:alldat-item-test-names data) ;; (tests (bubble-up tmptests priority: bubble-type)) ;; NOTE: 11/01/2013 This routine is *NOT* getting called excessively. ;; (debug:print 0 "Getting data for run " run-id " with key-vals=" key-vals) ;; Not sure this is needed? - (set! referenced-run-ids (cons run-id referenced-run-ids)) - (if (> (length tests) maxtests) - (set! maxtests (length tests))) - (if (or (not (d:alldat-hide-empty-runs data)) ;; this reduces the data burden when set - (not (null? tests))) - (let ((dstruct (vector run tests key-vals (- (current-seconds) 10)))) - (hash-table-set! (d:alldat-allruns-by-id data) run-id dstruct) - (set! result (cons dstruct result)))))) + (if (not (null? tests)) + (begin + (set! referenced-run-ids (cons run-id referenced-run-ids)) + (if (> (length tests) maxtests) + (set! maxtests (length tests))) + (if (or (not (d:alldat-hide-empty-runs data)) ;; this reduces the data burden when set + (not (null? tests))) + (let ((dstruct (vector run tests key-vals (- (current-seconds) 10)))) + (hash-table-set! (d:alldat-allruns-by-id data) run-id dstruct) + (set! result (cons dstruct result)))))))) runs) (d:alldat-header-set! data header) (d:alldat-allruns-set! data result) (debug:print-info 6 "(d:alldat-allruns data) has " (length (d:alldat-allruns data)) " runs") @@ -680,10 +685,11 @@ (hash-table-set! (d:alldat-searchpatts *alldat*) x val) (d:alldat-filters-changed-set! *alldat* #t) (set-bg-on-filter)) (define (mark-for-update) + (d:alldat-filters-changed-set! *alldat* #t) (d:alldat-last-db-update-set! *alldat* 0)) ;;====================================================================== ;; R U N C O N T R O L ;;====================================================================== @@ -1207,11 +1213,12 @@ (d:alldat-hide-not-hide data) #f #f "id,testname,item_path,state,status" (if (d:alldat-filters-changed data) 0 - last-update)) ;; get 'em all + last-update) + *dashboard-mode*) ;; get 'em all (db:get-tests-for-run db run-id (hash-table-ref/default (d:alldat-searchpatts data) "test-name" "%/%") (hash-table-keys (d:alldat-state-ignore-hash data)) ;; '() (hash-table-keys (d:alldat-status-ignore-hash data)) ;; '() #f #f @@ -1218,11 +1225,12 @@ (d:alldat-hide-not-hide data) #f #f "id,testname,item_path,state,status" (if (d:alldat-filters-changed data) 0 - last-update))) + last-update) + *dashboard-mode*)) '()))) ;; get 'em all (debug:print 0 "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id) (sort tdat (lambda (a b) (let* ((aval (vector-ref a 2)) (bval (vector-ref b 2)) @@ -1595,26 +1603,28 @@ #:title "state/status filter" (iup:vbox (apply iup:hbox (map (lambda (status) - (iup:toggle status #:action (lambda (obj val) - (mark-for-update) - (if (eq? val 1) - (hash-table-set! (d:alldat-status-ignore-hash data) status #t) - (hash-table-delete! (d:alldat-status-ignore-hash data) status)) - (set-bg-on-filter)))) + (iup:toggle (conc status " ") + #:action (lambda (obj val) + (mark-for-update) + (if (eq? val 1) + (hash-table-set! (d:alldat-status-ignore-hash data) status #t) + (hash-table-delete! (d:alldat-status-ignore-hash data) status)) + (set-bg-on-filter)))) (map cadr *common:std-statuses*))) ;; '("PASS" "FAIL" "WARN" "CHECK" "WAIVED" "STUCK/DEAD" "n/a" "SKIP"))) (apply iup:hbox (map (lambda (state) - (iup:toggle state #:action (lambda (obj val) - (mark-for-update) - (if (eq? val 1) - (hash-table-set! (d:alldat-state-ignore-hash data) state #t) - (hash-table-delete! (d:alldat-state-ignore-hash data) state)) - (set-bg-on-filter)))) + (iup:toggle (conc state " ") + #:action (lambda (obj val) + (mark-for-update) + (if (eq? val 1) + (hash-table-set! (d:alldat-state-ignore-hash data) state #t) + (hash-table-delete! (d:alldat-state-ignore-hash data) state)) + (set-bg-on-filter)))) (map cadr *common:std-states*))) ;; '("RUNNING" "COMPLETED" "INCOMPLETE" "LAUNCHED" "NOT_STARTED" "KILLED" "DELETED"))) (iup:valuator #:valuechanged_cb (lambda (obj) (let ((val (inexact->exact (round (/ (string->number (iup:attribute obj "VALUE")) 10)))) (oldmax (string->number (iup:attribute obj "MAX"))) (maxruns (d:alldat-tot-runs data)))