Overview
Comment: | Compacted dashboard layout |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.64-dashboard |
Files: | files | file ages | folders |
SHA1: |
5941191cd2682ef374df3afeebc0ae9d |
User & Date: | matt on 2017-04-24 23:53:36 |
Other Links: | branch diff | manifest | tags |
Context
2017-04-25
| ||
14:19 | Added detachablity to trees in dashboard so they can be detached and deleted. Closed-Leaf check-in: 08a1393c61 user: mrwellan tags: v1.64-dashboard | |
05:19 | Merged nice dashboard cleanup changes into v1.65 check-in: 66eb2de9fa user: matt tags: v1.65 | |
2017-04-24
| ||
23:53 | Compacted dashboard layout check-in: 5941191cd2 user: matt tags: v1.64-dashboard | |
22:00 | Quick hacks to make dashboard layout more efficient check-in: 61826e149f user: matt tags: v1.64-dashboard | |
Changes
Modified dashboard.scm from [eaafcb7912] to [edf1423278].
︙ | ︙ | |||
1421 1422 1423 1424 1425 1426 1427 | ;; #:size "10x30" )) (tb (iup:treebox #:value 0 #:name "Runs" #:expand "YES" | | | 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 | ;; #:size "10x30" )) (tb (iup:treebox #:value 0 #:name "Runs" #:expand "YES" #:addexpanded "YES" #:size "10x" #:selection-cb (lambda (obj id state) (debug:catch-and-dump (lambda () (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) |
︙ | ︙ | |||
1516 1517 1518 1519 1520 1521 1522 | (dcommon:command-runname-selector commondat tabdat tab-num: tab-num) (dcommon:command-testname-selector commondat tabdat update-keyvals)) (iup:vbox (iup:split #:orientation "HORIZONTAL" #:value 800 (let* ((cnv-obj (iup:canvas | | | 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 | (dcommon:command-runname-selector commondat tabdat tab-num: tab-num) (dcommon:command-testname-selector commondat tabdat update-keyvals)) (iup:vbox (iup:split #:orientation "HORIZONTAL" #:value 800 (let* ((cnv-obj (iup:canvas ;; #:size "250x250" ;; "500x400" #:expand "YES" #:scrollbar "YES" #:posx "0.5" #:posy "0.5" #:action (make-canvas-action (lambda (c xadj yadj) (debug:catch-and-dump |
︙ | ︙ | |||
1561 1562 1563 1564 1565 1566 1567 | ))) cnv-obj) (let* ((hb1 (iup:hbox)) (graph-cell-table (dboard:tabdat-graph-cell-table tabdat)) (changed #f) (graph-matrix (iup:matrix #:alignment1 "ALEFT" | | | | 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 | ))) cnv-obj) (let* ((hb1 (iup:hbox)) (graph-cell-table (dboard:tabdat-graph-cell-table tabdat)) (changed #f) (graph-matrix (iup:matrix #:alignment1 "ALEFT" ;; #:expand "YES" ;; "HORIZONTAL" #:scrollbar "YES" #:numcol 10 #:numlin 20 #:numcol-visible 5 ;; (min 8) #:numlin-visible 1 #:click-cb (lambda (obj row col status) (let* ((graph-cell (conc row ":" col)) (graph-dat (hash-table-ref/default graph-cell-table graph-cell #f)) (graph-flag (dboard:graph-dat-flag graph-dat))) |
︙ | ︙ | |||
1872 1873 1874 1875 1876 1877 1878 | ;; ;; General info about the run(s) and megatest area (define (dashboard:summary commondat tabdat #!key (tab-num #f)) (let* ((rawconfig (read-config (conc *toppath* "/megatest.config") #f #f)) ;; changed to #f since I want #{} to be expanded by [system ...] to NOT be expanded. WAS: 'return-string))) (changed #f)) (iup:vbox (iup:split | | | 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 | ;; ;; General info about the run(s) and megatest area (define (dashboard:summary commondat tabdat #!key (tab-num #f)) (let* ((rawconfig (read-config (conc *toppath* "/megatest.config") #f #f)) ;; changed to #f since I want #{} to be expanded by [system ...] to NOT be expanded. WAS: 'return-string))) (changed #f)) (iup:vbox (iup:split #:value 300 (iup:frame #:title "General Info" (iup:vbox (iup:hbox (iup:label "Area Path") (iup:textbox #:value *toppath* #:expand "HORIZONTAL")) (iup:hbox |
︙ | ︙ | |||
2055 2056 2057 2058 2059 2060 2061 | ;; (define (dashboard:runs-summary commondat tabdat #!key (tab-num #f)) (let* ((update-mutex (dboard:commondat-update-mutex commondat)) (tb (iup:treebox #:value 0 #:name "Runs" #:expand "YES" | | | 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 | ;; (define (dashboard:runs-summary commondat tabdat #!key (tab-num #f)) (let* ((update-mutex (dboard:commondat-update-mutex commondat)) (tb (iup:treebox #:value 0 #:name "Runs" #:expand "YES" #:addexpanded "YES" #:selection-cb (lambda (obj id state) (debug:catch-and-dump (lambda () ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) |
︙ | ︙ | |||
2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 | run-matrix) (dboard:make-controls commondat tabdat extra-widget: runs-summary-control-panel)))) ;;====================================================================== ;; R U N S ;;====================================================================== (define (dboard:make-controls commondat tabdat #!key (extra-widget #f) ) (let ((btn-fontsz (dboard:tabdat-runs-btn-fontsz tabdat))) (iup:hbox (iup:vbox (iup:frame #:title "filter test and items" (iup:vbox | > > > > > > > > > > > > > > > > > > | 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 | run-matrix) (dboard:make-controls commondat tabdat extra-widget: runs-summary-control-panel)))) ;;====================================================================== ;; R U N S ;;====================================================================== (define (dboard:squarify toggles size) (let loop ((hed (car toggles)) (tal (cdr toggles)) (cur '()) (res '())) (let* ((ovrflo (>= (length cur) size)) (newcur (if ovrflo (list hed) (cons hed cur))) (newres (if ovrflo (cons cur res) res))) (if (null? tal) (if ovrflo newres (cons newcur res)) (loop (car tal)(cdr tal) newcur newres))))) (define (dboard:make-controls commondat tabdat #!key (extra-widget #f) ) (let ((btn-fontsz (dboard:tabdat-runs-btn-fontsz tabdat))) (iup:hbox (iup:vbox (iup:frame #:title "filter test and items" (iup:vbox |
︙ | ︙ | |||
2270 2271 2272 2273 2274 2275 2276 | (iup:hbox)) ;; empty widget ))) | | | | | | | | | | | | | | | | | | | | | | | > > > | | > > > > > | > | | > > > > > > > > > | | | | | | > > > > > > | | | | | | | | | | | | | < < | 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 | (iup:hbox)) ;; empty widget ))) (let* ((status-toggles (map (lambda (status) (iup:toggle (conc status) #:fontsize 8 ;; btn-fontsz ;; "10" ;; #:expand "HORIZONTAL" #:action (lambda (obj val) (mark-for-update tabdat) (if (eq? val 1) (hash-table-set! (dboard:tabdat-status-ignore-hash tabdat) status #t) (hash-table-delete! (dboard:tabdat-status-ignore-hash tabdat) status)) (set-bg-on-filter commondat tabdat)))) (map cadr *common:std-statuses*))) ;; '("PASS" "FAIL" "WARN" "CHECK" "WAIVED" "STUCK/DEAD" "n/a" "SKIP"))) (state-toggles (map (lambda (state) (iup:toggle (conc state) #:fontsize 8 ;; btn-fontsz ;; #:expand "HORIZONTAL" #:action (lambda (obj val) (mark-for-update tabdat) (if (eq? val 1) (hash-table-set! (dboard:tabdat-state-ignore-hash tabdat) state #t) (hash-table-delete! (dboard:tabdat-state-ignore-hash tabdat) state)) (set-bg-on-filter commondat tabdat)))) (map cadr *common:std-states*))) ;; '("RUNNING" "COMPLETED" "INCOMPLETE" "LAUNCHED" "NOT_STARTED" "KILLED" "DELETED"))) (num-toggle-cols (inexact->exact (round (/ (max (length status-toggles)(length state-toggles)) 3))))) (iup:vbox (iup:hbox (iup:frame #:title "states" (apply iup:hbox (map (lambda (colgrp) (apply iup:vbox colgrp)) (dboard:squarify state-toggles 3)))) (iup:frame #:title "statuses" (apply iup:hbox (map (lambda (colgrp) (apply iup:vbox colgrp)) (dboard:squarify status-toggles 3))))) ;; ;; (iup:frame ;; #:title "state/status filter" ;; (iup:vbox ;; (apply ;; iup:hbox ;; (map ;; (lambda (status-toggle state-toggle) ;; (iup:vbox ;; status-toggle ;; state-toggle)) ;; status-toggles state-toggles)) ;; horizontal slider was here ))))) (define (dashboard:runs-horizontal-slider tabdat ) (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 (dboard:tabdat-tot-runs tabdat))) (dboard:tabdat-start-run-offset-set! tabdat val) (mark-for-update tabdat) (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax) (iup:attribute-set! obj "MAX" (* maxruns 10)))) #:expand "HORIZONTAL" #:max (* 10 (max (hash-table-size (dboard:tabdat-allruns-by-id tabdat)) 10)) #:min 0 #:step 0.01)) (define (dashboard:popup-menu run-id test-id target runname test-name testpatt item-test-path test-info) (iup:menu (iup:menu-item "Test Control Panel" #:action (lambda (obj) |
︙ | ︙ | |||
2644 2645 2646 2647 2648 2649 2650 | (iup:show (iup:dialog #:title (conc "Megatest dashboard " (current-user-name) ":" *toppath*) #:menu (dcommon:main-menu) (let* ((runs-view (iup:vbox (iup:split #:orientation "VERTICAL" ;; "HORIZONTAL" | | > > | > | 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 | (iup:show (iup:dialog #:title (conc "Megatest dashboard " (current-user-name) ":" *toppath*) #:menu (dcommon:main-menu) (let* ((runs-view (iup:vbox (iup:split #:orientation "VERTICAL" ;; "HORIZONTAL" #:value 100 (dboard:runs-tree-browser commondat runs-dat) (iup:split #:value 100 ;; left most block, including row names (apply iup:vbox lftlst) ;; right hand block, including cells (iup:vbox #:expand "YES" ;; the header (apply iup:hbox (reverse hdrlst)) (apply iup:hbox (reverse bdylst)) (dashboard:runs-horizontal-slider runs-dat)))) controls )) (views-cfgdat (common:load-views-config)) (additional-tabnames '()) (tab-start-num 5) ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW ;; (data (dboard:tabdat-init (make-d:data))) (additional-views ;; process views-dat |
︙ | ︙ | |||
2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 | "tabchangepos")) (dashboard:summary commondat stats-dat tab-num: 0) runs-view (dashboard:runs-summary commondat onerun-dat tab-num: 2) ;; (dashboard:new-view db data new-view-dat tab-num: 3) (dashboard:run-controls commondat runcontrols-dat tab-num: 3) (dashboard:run-times commondat runtimes-dat tab-num: 4) additional-views))) ;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c))) (iup:attribute-set! tabs "TABTITLE0" "Summary") (iup:attribute-set! tabs "TABTITLE1" "Runs") (iup:attribute-set! tabs "TABTITLE2" "Run Summary") (iup:attribute-set! tabs "TABTITLE3" "Run Control") (iup:attribute-set! tabs "TABTITLE4" "Run Times") | > | 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 | "tabchangepos")) (dashboard:summary commondat stats-dat tab-num: 0) runs-view (dashboard:runs-summary commondat onerun-dat tab-num: 2) ;; (dashboard:new-view db data new-view-dat tab-num: 3) (dashboard:run-controls commondat runcontrols-dat tab-num: 3) (dashboard:run-times commondat runtimes-dat tab-num: 4) ;; (dashboard:runs-summary commondat onerun-dat tab-num: 4) additional-views))) ;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c))) (iup:attribute-set! tabs "TABTITLE0" "Summary") (iup:attribute-set! tabs "TABTITLE1" "Runs") (iup:attribute-set! tabs "TABTITLE2" "Run Summary") (iup:attribute-set! tabs "TABTITLE3" "Run Control") (iup:attribute-set! tabs "TABTITLE4" "Run Times") |
︙ | ︙ |
Modified dcommon.scm from [71cb131d2d] to [21b14627b9].
︙ | ︙ | |||
489 490 491 492 493 494 495 | ;; Section to table (define (dcommon:section-matrix rawconfig sectionname varcolname valcolname #!key (title #f)) (let* ((curr-row-num 1) (key-vals (configf:section-vars rawconfig sectionname)) (section-matrix (iup:matrix #:alignment1 "ALEFT" | | | 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 | ;; Section to table (define (dcommon:section-matrix rawconfig sectionname varcolname valcolname #!key (title #f)) (let* ((curr-row-num 1) (key-vals (configf:section-vars rawconfig sectionname)) (section-matrix (iup:matrix #:alignment1 "ALEFT" ;; #:expand "YES" ;; "HORIZONTAL" #:numcol 1 #:numlin (length key-vals) #:numcol-visible 1 #:numlin-visible (min 10 (length key-vals)) #:scrollbar "YES"))) (iup:attribute-set! section-matrix "0:0" varcolname) (iup:attribute-set! section-matrix "0:1" valcolname) |
︙ | ︙ | |||
1183 1184 1185 1186 1187 1188 1189 | (hash-table-set! tests-draw-state 'scalef (+ scalef (if (> step 0) (* scalef 0.01) (* scalef -0.01)))) (if the-cnv (dashboard:draw-tests the-cnv last-xadj last-yadj tests-draw-state sorted-testnames test-records)) )) | | | 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 | (hash-table-set! tests-draw-state 'scalef (+ scalef (if (> step 0) (* scalef 0.01) (* scalef -0.01)))) (if the-cnv (dashboard:draw-tests the-cnv last-xadj last-yadj tests-draw-state sorted-testnames test-records)) )) ;; #:size "250x250" #:expand "YES" #:scrollbar "YES" #:posx "0.5" #:posy "0.5" #:button-cb (lambda (obj btn pressed x y status) ;; (print "obj: " obj ", pressed " pressed ", status " status) ; (print "canvas-origin: " (canvas-origin the-cnv)) |
︙ | ︙ |
Modified megatest.scm from [b43aea2964] to [2e8e526ed7].
︙ | ︙ | |||
422 423 424 425 426 427 428 | (system (conc "mkdir -p " log-dir))) (open-output-file logpath)) (exn () (debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath) (define *didsomething* #t) (exit 1)))) | | > > > | | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 | (system (conc "mkdir -p " log-dir))) (open-output-file logpath)) (exn () (debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath) (define *didsomething* #t) (exit 1)))) ;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not ;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation ;; where (launch:setup) returns #f? ;; (if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server (handle-exceptions exn (begin (print "ERROR: Failed to switch to log output. " ((conition-property-accessor 'exn 'message) exn)) ) (let* ((tl (or (args:get-arg "-log")(launch:setup))) ;; run launch:setup if -server, ensure we do NOT run launch:setup if -log specified (logf (or (args:get-arg "-log") ;; use -log unless we are a server, then craft a logfile name (conc tl "/logs/server-" (current-process-id) "-" (get-host-name) ".log"))) (oup (open-logfile logf))) (if (not (args:get-arg "-log")) (hash-table-set! args:arg-hash "-log" logf)) ;; fake out future queries of -log (debug:print-info 0 *default-log-port* "Sending log output to " logf) (set! *default-log-port* oup)))) |
︙ | ︙ |