Overview
| Comment: | Changed dashboard so that horizontal expansion is propagated to widgets so folks can expand to read long labels |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
45092ee176e566eec012787ff7737064 |
| User & Date: | mrwellan on 2012-11-05 14:42:29 |
| Other Links: | manifest | tags |
Context
|
2012-11-05
| ||
| 14:43 | bumped version to v1.5114 check-in: 628e669a08 user: mrwellan tags: trunk, v1.5114 | |
| 14:42 | Changed dashboard so that horizontal expansion is propagated to widgets so folks can expand to read long labels check-in: 45092ee176 user: mrwellan tags: trunk | |
| 13:40 | Slight improvement to catching of ^c and flushing of server communication. Servers still dies sometimes check-in: 9daa64433e user: mrwellan tags: trunk, v1.5112 | |
Changes
Modified dashboard.scm from [9d10f68f9f] to [5a6e0cab75].
| ︙ | ︙ | |||
490 491 492 493 494 495 496 |
)
;; create the left most column for the run key names and the test names
(set! lftlst (list (iup:hbox
(iup:label) ;; (iup:valuator)
(apply iup:vbox
(map (lambda (x)
| | | | | | | > | | | 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 |
)
;; create the left most column for the run key names and the test names
(set! lftlst (list (iup:hbox
(iup:label) ;; (iup:valuator)
(apply iup:vbox
(map (lambda (x)
(let ((res (iup:hbox #:expand "HORIZONTAL"
(iup:label x #:size "x15" #:fontsize "10" #:expand "HORIZONTAL")
(iup:textbox #:size "x15" #:fontsize "10" #:value "%" #:expand "HORIZONTAL"
#:action (lambda (obj unk val)
(mark-for-update)
(update-search x val))))))
(set! i (+ i 1))
res))
keynames)))))
(let loop ((testnum 0)
(res '()))
(cond
((>= testnum ntests)
;; now lftlst will be an hbox with the test keys and the test name labels
(set! lftlst (append lftlst (list (iup:hbox #:expand "HORIZONTAL"
(iup:valuator #:valuechanged_cb (lambda (obj)
(let ((val (string->number (iup:attribute obj "VALUE")))
(oldmax (string->number (iup:attribute obj "MAX")))
(newmax (* 10 (length *alltestnamelst*))))
(set! *please-update-buttons* #t)
(set! *start-test-offset* (inexact->exact (round (/ val 10))))
(debug:print 6 "*start-test-offset* " *start-test-offset* " val: " val " newmax: " newmax " oldmax: " oldmax)
(if (< val 10)
(iup:attribute-set! obj "MAX" newmax))
))
#:expand "VERTICAL"
#:orientation "VERTICAL")
(apply iup:vbox (reverse res)))))))
(else
(let ((labl (iup:button ""
#:flat "YES"
#:alignment "ALEFT"
; #:image img1
; #:impress img2
#:size "x15"
#:expand "HORIZONTAL"
#:fontsize "10"
#:action (lambda (obj)
(mark-for-update)
(toggle-hide testnum))))) ;; (iup:attribute obj "TITLE"))))
(vector-set! lftcol testnum labl)
(loop (+ testnum 1)(cons labl res))))))
;;
(let loop ((runnum 0)
(keynum 0)
(keyvec (make-vector nkeys))
(res '()))
(cond ;; nb// no else for this approach.
((>= runnum nruns) #f)
((>= keynum nkeys)
(vector-set! header runnum keyvec)
(set! hdrlst (cons (apply iup:vbox (reverse res)) hdrlst))
(loop (+ runnum 1) 0 (make-vector nkeys) '()))
(else
(let ((labl (iup:label "" #:size "60x15" #:fontsize "10" #:expand "HORIZONTAL"))) ;; #:expand "HORIZONTAL"
(vector-set! keyvec keynum labl)
(loop runnum (+ keynum 1) keyvec (cons labl res))))))
;; By here the hdrlst contains a list of vboxes containing nkeys labels
(let loop ((runnum 0)
(testnum 0)
(testvec (make-vector ntests))
(res '()))
(cond
((>= runnum nruns) #f) ;; (vector tableheader runsvec))
((>= testnum ntests)
(vector-set! runsvec runnum testvec)
(set! bdylst (cons (apply iup:vbox (reverse res)) bdylst))
(loop (+ runnum 1) 0 (make-vector ntests) '()))
(else
(let* ((button-key (mkstr runnum testnum))
(butn (iup:button "" ;; button-key
#:size "60x15"
#:expand "HORIZONTAL"
#:fontsize "10"
#:action (lambda (x)
(let* ((toolpath (car (argv)))
(buttndat (hash-table-ref *buttondat* button-key))
(test-id (db:test-get-id (vector-ref buttndat 3)))
(cmd (conc toolpath " -test " test-id "&")))
;(print "Launching " cmd)
|
| ︙ | ︙ |