Overview
| Comment: | Cleaned up label and test button filling code, collapsing works better now |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | debug-printing |
| Files: | files | file ages | folders |
| SHA1: |
084d0426f222a0665fe139a6fa2c1b20 |
| User & Date: | mrwellan on 2011-06-30 22:27:04 |
| Other Links: | branch diff | manifest | tags |
Context
|
2011-07-01
| ||
| 13:56 | Set color on labels when tests with items are collapsed Closed-Leaf check-in: 1d2b01ea26 user: mrwellan tags: debug-printing | |
|
2011-06-30
| ||
| 22:27 | Cleaned up label and test button filling code, collapsing works better now check-in: 084d0426f2 user: mrwellan tags: debug-printing | |
| 16:10 | Added ability to collapse itemized tests check-in: 501196c236 user: mrwellan tags: debug-printing | |
Changes
Modified dashboard.scm from [78325e2e00] to [34618ac6f7].
| ︙ | ︙ | |||
77 78 79 80 81 82 83 | (define max-test-num 0) (define *keys* (get-keys *db*)) (define dbkeys (map (lambda (x)(vector-ref x 0)) (append *keys* (list (vector "runname" "blah"))))) (define *header* #f) (define *allruns* '()) (define *buttondat* (make-hash-table)) ;; <run-id color text test run-key> | < | 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | (define max-test-num 0) (define *keys* (get-keys *db*)) (define dbkeys (map (lambda (x)(vector-ref x 0)) (append *keys* (list (vector "runname" "blah"))))) (define *header* #f) (define *allruns* '()) (define *buttondat* (make-hash-table)) ;; <run-id color text test run-key> (define *alltestnamelst* '()) (define *searchpatts* (make-hash-table)) (define *num-runs* 10) (define *num-tests* 15) (define *start-run-offset* 0) (define *start-test-offset* 0) (define *examine-test-dat* (make-hash-table)) |
| ︙ | ︙ | |||
147 148 149 150 151 152 153 | (define *collapsed* (make-hash-table)) ; (define *row-lookup* (make-hash-table)) ;; testname => (rownum lableobj) (define (toggle-hide lnum) ; fulltestname) (let* ((btn (vector-ref (vector-ref uidat 0) lnum)) (fulltestname (iup:attribute btn "TITLE")) | | | 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 |
(define *collapsed* (make-hash-table))
; (define *row-lookup* (make-hash-table)) ;; testname => (rownum lableobj)
(define (toggle-hide lnum) ; fulltestname)
(let* ((btn (vector-ref (vector-ref uidat 0) lnum))
(fulltestname (iup:attribute btn "TITLE"))
(parts (string-split fulltestname "("))
(basetestname (if (null? parts) "" (car parts))))
;(print "Toggling " basetestname " currently " (hash-table-ref/default *collapsed* basetestname #f))
(if (hash-table-ref/default *collapsed* basetestname #f)
(hash-table-delete! *collapsed* basetestname)
(hash-table-set! *collapsed* basetestname #t))))
(define blank-line-rx (regexp "^\\s*$"))
|
| ︙ | ︙ | |||
193 194 195 196 197 198 199 |
(maxn (- numcols 1))
(allvals (make-vector numcols "")))
(for-each (lambda (name)
(if (<= rown maxn)
(let ((labl (vector-ref lftcol rown)))
(vector-set! allvals rown name)))
(set! rown (+ 1 rown)))
| > | | | < < < | | 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 |
(maxn (- numcols 1))
(allvals (make-vector numcols "")))
(for-each (lambda (name)
(if (<= rown maxn)
(let ((labl (vector-ref lftcol rown)))
(vector-set! allvals rown name)))
(set! rown (+ 1 rown)))
*alltestnamelst*)
; (if (> (length *alltestnamelst*) *start-test-offset*)
; (drop *alltestnamelst* *start-test-offset*)
; '()))
(let loop ((i 0))
(let* ((lbl (vector-ref lftcol i))
(oldval (iup:attribute lbl "TITLE"))
(newval (vector-ref allvals i)))
(if (not (equal? oldval newval))
(iup:attribute-set! lbl "TITLE" newval))
(if (< i maxn)
(loop (+ i 1)))))))
(define (get-color-for-state-status state status)
(case (string->symbol state)
((COMPLETED)
(if (equal? status "PASS")
|
| ︙ | ︙ | |||
230 231 232 233 234 235 236 |
((NOT_STARTED) "240 240 240")
(else "192 192 192")))
(define (update-buttons uidat numruns numtests)
(let* ((runs (if (> (length *allruns*) numruns)
(take-right *allruns* numruns)
(pad-list *allruns* numruns)))
| < < < | | < | | | | | | < < < < < < < | 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 |
((NOT_STARTED) "240 240 240")
(else "192 192 192")))
(define (update-buttons uidat numruns numtests)
(let* ((runs (if (> (length *allruns*) numruns)
(take-right *allruns* numruns)
(pad-list *allruns* numruns)))
(lftcol (vector-ref uidat 0))
(tableheader (vector-ref uidat 1))
(table (vector-ref uidat 2))
(coln 0))
(set! *alltestnamelst* '())
;; create a concise list of test names
(for-each (lambda (rundat)
(if (vector? rundat)
(let* ((testdat (vector-ref rundat 1))
(testnames (map test:test-get-fullname testdat)))
(for-each (lambda (testname)
(if (not (member testname *alltestnamelst*))
(begin
(set! *alltestnamelst* (append *alltestnamelst* (list testname))))))
testnames))))
runs)
(set! *alltestnamelst* (collapse-rows *alltestnamelst*)) ;;; argh. please clean up this sillyness
(set! *alltestnamelst* (let ((xl (if (> (length *alltestnamelst*) *start-test-offset*)
(drop *alltestnamelst* *start-test-offset*)
'())))
(append xl (make-list (- *num-tests* (length xl)) ""))))
(update-labels uidat)
(for-each
(lambda (rundat)
(if (not rundat) ;; handle padded runs
;; ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration
(set! rundat (vector (make-vector 20 #f) '() (map (lambda (x) "") *keys*))));; 3)))
(let* ((run (vector-ref rundat 0))
(testsdat (vector-ref rundat 1))
|
| ︙ | ︙ |