Overview
Comment: | Some clean up after refactor |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.61 |
Files: | files | file ages | folders |
SHA1: |
8302b2e45af1ec406a7d1cc57484a373 |
User & Date: | matt on 2016-07-10 21:45:48 |
Other Links: | branch diff | manifest | tags |
Context
2016-07-10
| ||
23:57 | More cleanup check-in: 2895ef3399 user: matt tags: v1.61 | |
21:45 | Some clean up after refactor check-in: 8302b2e45a user: matt tags: v1.61 | |
20:20 | Refactored updaters. Not completed yet but it compiles check-in: 908a92225c user: matt tags: v1.61 | |
Changes
Modified dashboard.scm from [b54049fefc] to [d875af2eaf].
︙ | ︙ | |||
1084 1085 1086 1087 1088 1089 1090 | (iup:vbox (dcommon:section-matrix rawconfig "server" "Varname" "Value") ;; (iup:frame ;; #:title "Disks Areas" (dcommon:section-matrix rawconfig "disks" "Disk area" "Path")))) (iup:frame #:title "Run statistics" | | | 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 | (iup:vbox (dcommon:section-matrix rawconfig "server" "Varname" "Value") ;; (iup:frame ;; #:title "Disks Areas" (dcommon:section-matrix rawconfig "disks" "Disk area" "Path")))) (iup:frame #:title "Run statistics" (dcommon:run-stats commondat tabdat))))) ;;====================================================================== ;; R U N ;;====================================================================== ;; ;; display and manage a single run at a time |
︙ | ︙ | |||
1829 1830 1831 1832 1833 1834 1835 | (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn)) (current-seconds)) ;; something went wrong - just print an error and return current-seconds (apply max (map (lambda (filen) (file-modification-time filen)) (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db")))))) (define (dashboard:monitor-changed? commondat tabdat) | > | | 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 | (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn)) (current-seconds)) ;; something went wrong - just print an error and return current-seconds (apply max (map (lambda (filen) (file-modification-time filen)) (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db")))))) (define (dashboard:monitor-changed? commondat tabdat) (let* ((run-update-time (current-seconds)) (monitor-db-path (dboard:tabdat-monitor-db-path tabdat)) (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path)) (file-modification-time monitor-db-path) -1))) (if (and (eq? (dboard:commondat-curr-tab-num commondat) 0) (or (> monitor-modtime *last-monitor-update-time*) (> (- run-update-time *last-monitor-update-time*) 5))) ;; update every 1/2 minute just in case (begin |
︙ | ︙ | |||
1916 1917 1918 1919 1920 1921 1922 | (dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat)) ;; (dboard:tabdat-dblocal data) ;; (dboard:tabdat-numruns tabdat) ;; (dboard:tabdat-num-tests tabdat) ;; (dboard:tabdat-dbkeys tabdat) ;; runs-sum-dat new-view-dat)) ;; legacy setup of updaters for summary tab and runs tab ;; summary tab | | | | | | | 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 | (dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat)) ;; (dboard:tabdat-dblocal data) ;; (dboard:tabdat-numruns tabdat) ;; (dboard:tabdat-num-tests tabdat) ;; (dboard:tabdat-dbkeys tabdat) ;; runs-sum-dat new-view-dat)) ;; legacy setup of updaters for summary tab and runs tab ;; summary tab ;; (dboard:commondat-add-updater ;; commondat ;; (lambda () ;; (dashboard:summary-tab-updater commondat 0)) ;; tab-num: 0) ;; runs tab (dboard:commondat-add-updater commondat (lambda () (dashboard:runs-tab-updater commondat 1)) tab-num: 1) (iup:callback-set! *tim* |
︙ | ︙ | |||
1948 1949 1950 1951 1952 1953 1954 | (mutex-unlock! (dboard:commondat-update-mutex commondat))) )) 1)))) (let ((th1 (make-thread (lambda () (thread-sleep! 1) (dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab (dboard:commondat-please-update-set! commondat #t) | | | 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 | (mutex-unlock! (dboard:commondat-update-mutex commondat))) )) 1)))) (let ((th1 (make-thread (lambda () (thread-sleep! 1) (dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab (dboard:commondat-please-update-set! commondat #t) ;; (dashboard:run-update commondat) ) "update buttons once")) (th2 (make-thread iup:main-loop "Main loop"))) (thread-start! th1) (thread-start! th2) (thread-join! th2)))) (main) |
Modified dcommon.scm from [3d55a423e4] to [60f5633a1e].
︙ | ︙ | |||
354 355 356 357 358 359 360 | ;; (iup:attribute-set! general-matrix "2:1" *toppath*) ;; Megatest version (iup:attribute-set! general-matrix "2:0" "Version") (iup:attribute-set! general-matrix "2:1" (conc megatest-version "-" (substring megatest-fossil-hash 0 4))) general-matrix)) | | > | | 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 | ;; (iup:attribute-set! general-matrix "2:1" *toppath*) ;; Megatest version (iup:attribute-set! general-matrix "2:0" "Version") (iup:attribute-set! general-matrix "2:1" (conc megatest-version "-" (substring megatest-fossil-hash 0 4))) general-matrix)) (define (dcommon:run-stats commondat tabdat) (let* ((stats-matrix (iup:matrix expand: "YES")) (changed #f) (updater (lambda () (if (dashboard:database-changed? commondat tabdat) (let* ((run-stats (rmt:get-run-stats)) (indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell)) (row-indices (car indices)) (col-indices (cadr indices)) (max-row (if (null? row-indices) 1 (apply max (map cadr row-indices)))) (max-col (if (null? col-indices) 1 (apply max (map cadr col-indices)))) (max-visible (max (- (dboard:tabdat-num-tests tabdat) 15) 3)) (max-col-vis (if (> max-col 10) 10 max-col)) (numrows 1) (numcols 1)) (iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS") (iup:attribute-set! stats-matrix "NUMCOL" max-col ) (iup:attribute-set! stats-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20 (iup:attribute-set! stats-matrix "NUMCOL_VISIBLE" max-col-vis) |
︙ | ︙ | |||
410 411 412 413 414 415 416 | (col-num (cadr (assoc col-name col-indices))) (key (conc row-num ":" col-num))) (if (not (equal? (iup:attribute stats-matrix key) value)) (begin (set! changed #t) (iup:attribute-set! stats-matrix key value))))) run-stats) | | > | | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 | (col-num (cadr (assoc col-name col-indices))) (key (conc row-num ":" col-num))) (if (not (equal? (iup:attribute stats-matrix key) value)) (begin (set! changed #t) (iup:attribute-set! stats-matrix key value))))) run-stats) (if changed (iup:attribute-set! stats-matrix "REDRAW" "ALL"))))))) (updater) (dboard:commondat-add-updater commondat updater) ;; (set! dashboard:update-summary-tab updater) (iup:attribute-set! stats-matrix "WIDTHDEF" "40") (iup:vbox ;; (iup:label "Run statistics" #:expand "HORIZONTAL") stats-matrix))) (define (dcommon:servers-table commondat tabdat) (let* ((tdbdat (tasks:open-db)) |
︙ | ︙ | |||
474 475 476 477 478 479 480 | servers)))))) (set! colnum 0) (for-each (lambda (colname) (iup:attribute-set! servers-matrix (conc "0:" colnum) colname) (iup:attribute-set! servers-matrix "FITTOTEXT" (conc "C" colnum)) (set! colnum (+ colnum 1))) colnames) | | > | 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 | servers)))))) (set! colnum 0) (for-each (lambda (colname) (iup:attribute-set! servers-matrix (conc "0:" colnum) colname) (iup:attribute-set! servers-matrix "FITTOTEXT" (conc "C" colnum)) (set! colnum (+ colnum 1))) colnames) ;; (set! dashboard:update-servers-table updater) (dboard:commondat-add-updater commondat updater) ;; (iup:attribute-set! servers-matrix "WIDTHDEF" "40") ;; (iup:hbox ;; (iup:vbox ;; (iup:button "Start" ;; ;; #:size "50x" ;; #:expand "YES" ;; #:action (lambda (obj) |
︙ | ︙ | |||
915 916 917 918 919 920 921 | #:title "SELECTORS" (iup:vbox ;; Text box for test patterns (iup:frame #:title "Test patterns (one per line)" (let ((tb (iup:textbox #:action (lambda (val a b) (dboard:tabdat-test-patts-set!-use | | | 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 | #:title "SELECTORS" (iup:vbox ;; Text box for test patterns (iup:frame #:title "Test patterns (one per line)" (let ((tb (iup:textbox #:action (lambda (val a b) (dboard:tabdat-test-patts-set!-use tabdat (dboard:lines->test-patt b)) (dashboard:update-run-command tabdat)) #:value (dboard:test-patt->lines (dboard:tabdat-test-patts-use tabdat)) #:expand "YES" #:size "x50" #:multiline "YES"))) |
︙ | ︙ |