Overview
| Comment: | Minor changes for run control panel |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | runcontrol |
| Files: | files | file ages | folders |
| SHA1: |
f6a292210ea24218d6749bd91a9197c2 |
| User & Date: | mrwellan on 2013-04-19 18:12:26 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-04-20
| ||
| 11:49 | first cut at hierarchial selector for targets check-in: b4c4ed6017 user: matt tags: runcontrol | |
|
2013-04-19
| ||
| 18:12 | Minor changes for run control panel check-in: f6a292210e user: mrwellan tags: runcontrol | |
| 00:33 | Starting on dashboard run control panel check-in: b504d0edc5 user: matt tags: runcontrol | |
Changes
Modified dashboard.scm from [a421d98c79] to [af16f05103].
| ︙ | ︙ | |||
438 439 440 441 442 443 444 |
(db-targets (vector-ref db-target-dat 1))
(tests (make-hash-table))
(action "-runtests")
(cmdln "")
(runlogs (make-hash-table)))
;; refer to *keys*, *dbkeys* for keys
(print "db-targets: " db-targets)
| | | | | | | | | > > > | > > > > > > > > | > > | | | | | | | | | | | | | | | | < > | | | | | 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 |
(db-targets (vector-ref db-target-dat 1))
(tests (make-hash-table))
(action "-runtests")
(cmdln "")
(runlogs (make-hash-table)))
;; refer to *keys*, *dbkeys* for keys
(print "db-targets: " db-targets)
(iup:vbox
(iup:hbox
;; Target and action
(iup:vbox
;; Target selectors
(apply iup:hbox
(map
(lambda (key)
(print "Label key=" key)
(let ((lb (iup:listbox
key
#:size "x15"
#:fontsize "10"
#:expand "YES"
#:value "1"
#:dropdown "YES"
)))
(let loop ((count 1))
(iup:attribute-set!
lb count
(db:get-value-by-header row header field)
header)))
))))
;; ;; key1 key2 key3 ...
;; ;; target entry (wild cards allowed)
;;
;; ;; The action
;; (iup:hbox
;; ;; label Action | action selector
;; ))
;; ;; Test/items selector
;; (iup:hbox
;; ;; tests
;; ;; items
;; ))
;; ;; The command line
;; (iup:hbox
;; ;; commandline entry
;; ;; GO button
;; )
;; ;; The command log monitor
;; (iup:tabs
;; ;; log monitor
;; )))
;;======================================================================
;; R U N S
;;======================================================================
(define (make-dashboard-buttons nruns ntests keynames)
(let* ((nkeys (length keynames))
|
| ︙ | ︙ |
Modified db.scm from [a3efd215ca] to [6e6a12b542].
| ︙ | ︙ | |||
504 505 506 507 508 509 510 511 512 513 514 515 516 517 |
(set! res (cons (vector key keytype) res)))
db
"SELECT fieldname,fieldtype FROM keys ORDER BY id DESC;")
(set! *db-keys* res)
(debug:print-info 11 "db:get-keys END (cache miss)")
res)))
(define (db:get-value-by-header row header field)
(debug:print-info 4 "db:get-value-by-header row: " row " header: " header " field: " field)
(if (null? header) #f
(let loop ((hed (car header))
(tal (cdr header))
(n 0))
(if (equal? hed field)
| > | 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 |
(set! res (cons (vector key keytype) res)))
db
"SELECT fieldname,fieldtype FROM keys ORDER BY id DESC;")
(set! *db-keys* res)
(debug:print-info 11 "db:get-keys END (cache miss)")
res)))
;;
(define (db:get-value-by-header row header field)
(debug:print-info 4 "db:get-value-by-header row: " row " header: " header " field: " field)
(if (null? header) #f
(let loop ((hed (car header))
(tal (cdr header))
(n 0))
(if (equal? hed field)
|
| ︙ | ︙ |