Overview
| Comment: | Added user views to dashboard |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.61 |
| Files: | files | file ages | folders |
| SHA1: |
f2bc1dae9ef893df351a28fd8221f668 |
| User & Date: | matt on 2016-09-10 18:36:14 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-09-10
| ||
| 18:40 | fixed typo check-in: 83628669f4 user: matt tags: v1.61 | |
| 18:36 | Added user views to dashboard check-in: f2bc1dae9e user: matt tags: v1.61 | |
|
2016-09-09
| ||
| 18:07 | Fix for locked up dashboard in area with many runs check-in: a8a40649b9 user: mrwellan tags: v1.61 | |
Changes
Modified common.scm from [8d88deb1b5] to [14a3d2fe92].
| ︙ | ︙ | |||
1293 1294 1295 1296 1297 1298 1299 | (loop (car tal)(cdr tal))))))) ;; no match, try again (if (null? tal) fallback-launcher (loop (car tal)(cdr tal)))))))) fallback-launcher))) | > > > > > > > > > > > > > > > > > | 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 |
(loop (car tal)(cdr tal)))))))
;; no match, try again
(if (null? tal)
fallback-launcher
(loop (car tal)(cdr tal))))))))
fallback-launcher)))
;;======================================================================
;; D A S H B O A R D U S E R V I E W S
;;======================================================================
;; first read ~/views.config if it exists, then read $MTRAH/views.config if it exists
;;
(define (common:load-views-config)
(let* ((view-cfgdat (make-hash-table))
(home-cfgfile (conc (get-environment-variable "HOME") "/.mtviews.config"))
(mthome-cfgfile (conc *toppath* "/.mtviews.config")))
(if (file-exists? mthome-cfgfile)
(read-config mthome-cfgfile view-cfgdat #t))
;; we load the home dir file AFTER the MTRAH file so the user can clobber settings when running the dashboard in read-only areas
(if (file-exists? home-cfgfile)
(read-config home-cfgfile view-cfgdat #t))
view-cfgdat))
|
Modified dashboard.scm from [ba121be96f] to [870437c7a8].
| ︙ | ︙ | |||
1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 |
(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 tab-num: tab-num)))))
;;======================================================================
;; R U N
;;======================================================================
;;
;; display and manage a single run at a time
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 |
(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 tab-num: tab-num)))))
;;======================================================================
;; H A N D L E U S E R C O N T R I B U T E D V I E W S
;;======================================================================
(define (dboard:add-external-tab commondat view-name views-cfgdat tabs tab-num)
(let* ((success #t) ;; at any stage of the process set this flag to #f to skip downstream steps. Intention here is to recover gracefully if user provided tabs fail to load.
(source (configf:lookup views-cfgdat view-name "source"))
(viewgen (configf:lookup views-cfgdat view-name "viewgen"))
(updater (configf:lookup views-cfgdat view-name "updater"))
(result-child #f))
(if (and (file-exists? source)
(file-read-access? source))
(handle-exceptions
exn
(begin
(print-call-chain)
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 *default-log-port* "ERROR: failed to load " source ", try loading in the repl: megatest -repl")
(set! success #f))
(load source))
(begin
(debug:print 0 *default-log-port* "ERROR: cannot find file to load: \"" source "\" for user view " view-name)))
;; now run the user supplied definition for the tab view
(if success
(handle-exceptions
exn
(begin
(print-call-chain)
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 *default-log-port* "ERROR: failed call procedure " viewgen
", with; tab-num=" tab-num ", view-name=" view-name
", and views-cfgdat and megatest configdat as parameters. To debug try loading in the repl: megatest -repl")
(set! success #f))
(print "Adding tab " view-name " with proc " viewgen)
;; (iup:child-add! tabs
(set! result-child
((eval (string->symbol viewgen)) tabs tab-num view-name views-cfgdat *configdat*))))
;; and finally set the updater
(if success
(dboard:commondat-add-updater commondat
(lambda ()
(handle-exceptions
exn
(begin
(print-call-chain)
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 *default-log-port* "ERROR: failed call procedure \"" updater
"\", with; tabnum=" tabnum ", view-name=" view-name
", and views-cfgdat and megatest configdat as parameters. To debug try loading in the repl: megatest -repl")
(set! success #f))
(debug:print 4 *default-log-port* "Running updater for tab " view-name " with proc " updater " and tab-num: " tab-num)
((eval (string->symbol updater)) tabs tab-num view-name views-cfgdat *configdat*)))
tab-num: tab-num))
(if success
(begin
;; (iup:attribute-set! tabs (conc "TABTITLE" tab-num) view-name)
(dboard:common-set-tabdat! commondat tab-num (dboard:tabdat-make-data))))
result-child))
;;======================================================================
;; R U N
;;======================================================================
;;
;; display and manage a single run at a time
|
| ︙ | ︙ | |||
2041 2042 2043 2044 2045 2046 2047 2048 | ;; right hand block, including cells (iup:vbox ;; the header (apply iup:hbox (reverse hdrlst)) (apply iup:hbox (reverse bdylst))))) controls )) ;; (data (dboard:tabdat-init (make-d:data))) | > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | | | | | | | | | | > > > > > > > > | 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 |
;; right hand block, including cells
(iup:vbox
;; the header
(apply iup:hbox (reverse hdrlst))
(apply iup:hbox (reverse bdylst)))))
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
(let ((tab-num tab-start-num)
(result '()))
(for-each
(lambda (view-name)
(debug:print 0 *default-log-port* "Adding view " view-name)
(let* ((cfgtype (configf:lookup views-cfgdat view-name "type"))) ;; what type of view?
(if (not (string? cfgtype))
(debug:print-info 0 *default-log-port* "WARNING: view \"" view-name
"\" is missing needed sections. Please consult the documenation and update ~/.mtviews.config or " *toppath* "/.mtviews.config")
(case (string->symbol cfgtype)
;; user supplied source for a tab
;;
((external)
(let ((tab-content (dboard:add-external-tab commondat view-name views-cfgdat #f tab-num))) ;; was tabs
(set! additional-tabnames (cons (cons tab-num view-name) additional-tabnames))
(set! tab-num (+ tab-num 1))
(set! result (append result (list tab-content)))))))))
(sort (hash-table-keys views-cfgdat) (lambda (a b)
(let ((order-a (or (any-number (configf:lookup views-cfgdat a "order")) 999))
(order-b (or (any-number (configf:lookup views-cfgdat b "order")) 999)))
(> order-a order-b)))))
result))
(tabs (apply iup:tabs
#:tabchangepos-cb (lambda (obj curr prev)
(debug:catch-and-dump
(lambda ()
(let* ((tab-num (dboard:commondat-curr-tab-num commondat))
(tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))
(dboard:tabdat-layout-update-ok-set! tabdat #f))
(dboard:commondat-curr-tab-num-set! commondat curr)
(let* ((tab-num (dboard:commondat-curr-tab-num commondat))
(tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))
(dboard:commondat-please-update-set! commondat #t)
(dboard:tabdat-layout-update-ok-set! tabdat #t)))
"tabchangepos"))
(dashboard:summary commondat stats-dat tab-num: 0)
runs-view
(dashboard:one-run 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")
;; (iup:attribute-set! tabs "TABTITLE3" "New View")
;; (iup:attribute-set! tabs "TABTITLE4" "Run Control")
;; set the tab names for user added tabs
(for-each
(lambda (tab-info)
(iup:attribute-set! tabs (conc "TABTITLE" (car tab-info)) (cdr tab-info)))
additional-tabnames)
(iup:attribute-set! tabs "BGCOLOR" "190 190 190")
;; make the iup tabs object available (for changing color for example)
(dboard:commondat-hide-not-hide-tabs-set! commondat tabs)
;; now set up the tabdat lookup
(dboard:common-set-tabdat! commondat 0 stats-dat)
(dboard:common-set-tabdat! commondat 1 runs-dat)
(dboard:common-set-tabdat! commondat 2 onerun-dat)
(dboard:common-set-tabdat! commondat 3 runcontrols-dat)
(dboard:common-set-tabdat! commondat 4 runtimes-dat)
(iup:vbox
tabs
;; controls
))))
(vector keycol lftcol header runsvec)))
(define (dboard:setup-num-rows tabdat)
|
| ︙ | ︙ |