Overview
| Comment: | Made the LH column controls independent for each tab |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.61 |
| Files: | files | file ages | folders |
| SHA1: |
c4ce2f7187f2d880bcaa5708efaf67b3 |
| User & Date: | matt on 2016-06-30 23:49:22 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-07-01
| ||
| 08:41 | Partial migration of *data* to a defstruct check-in: 75c0c4c195 user: mrwellan tags: v1.61 | |
|
2016-06-30
| ||
| 23:49 | Made the LH column controls independent for each tab check-in: c4ce2f7187 user: matt tags: v1.61 | |
| 04:57 | Added re-run of test to rhb menu check-in: a38b157d75 user: matt tags: v1.61 | |
Changes
Modified dashboard.scm from [52da789fe9] to [d24b4d7b16].
| ︙ | ︙ | |||
805 806 807 808 809 810 811 | (hash-table-set! alltgls item #t)) (let ((all (hash-table-keys alltgls))) (proc all))))) items)))) ;; Extract the various bits of data from *data* and create the command line equivalent that will be displayed ;; | | | | | | | | | | 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 | (hash-table-set! alltgls item #t)) (let ((all (hash-table-keys alltgls))) (proc all))))) items)))) ;; Extract the various bits of data from *data* and create the command line equivalent that will be displayed ;; (define (dashboard:update-run-command data) (let* ((cmd-tb (dboard:data-get-command-tb data)) (cmd (dboard:data-get-command data)) (test-patt (let ((tp (dboard:data-get-test-patts data))) (if (equal? tp "") "%" tp))) (states (dboard:data-get-states data)) (statuses (dboard:data-get-statuses data)) (target (let ((targ-list (dboard:data-get-target data))) (if targ-list (string-intersperse targ-list "/") "no-target-selected"))) (run-name (dboard:data-get-run-name data)) (states-str (if (or (not states) (null? states)) "" (conc " -state " (string-intersperse states ",")))) (statuses-str (if (or (not statuses) (null? statuses)) "" |
| ︙ | ︙ | |||
877 878 879 880 881 882 883 | ;;====================================================================== ;; R U N C O N T R O L S ;;====================================================================== ;; ;; A gui for launching tests ;; | | > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 |
;;======================================================================
;; R U N C O N T R O L S
;;======================================================================
;;
;; A gui for launching tests
;;
(define (dashboard:run-controls alldat)
(let* ((data (make-vector 25 #f))
(targets (make-hash-table))
(test-records (make-hash-table))
(all-tests-registry (tests:get-all)) ;; (tests:get-valid-tests *toppath* '()))
(test-names (hash-table-keys all-tests-registry))
(sorted-testnames #f)
(action "-run")
(cmdln "")
(runlogs (make-hash-table))
(key-listboxes #f)
;; (updater-for-runs #f)
(update-keyvals (lambda ()
(let ((targ (map (lambda (x)
(iup:attribute x "VALUE"))
(car (dashboard:update-target-selector key-listboxes))))
(curr-runname (dboard:data-get-run-name data)))
(dboard:data-set-target! data targ)
(if (dboard:data-get-updater-for-runs data)
((dboard:data-get-updater-for-runs data)))
(if (or (not (equal? curr-runname (dboard:data-get-run-name data)))
(equal? (dboard:data-get-run-name data) ""))
(dboard:data-set-run-name! data curr-runname))
(dashboard:update-run-command data))))
(tests-draw-state (make-hash-table)) ;; use for keeping state of the test canvas
(test-patterns-textbox #f))
(hash-table-set! tests-draw-state 'first-time #t)
;; (hash-table-set! tests-draw-state 'scalef 1)
(tests:get-full-data test-names test-records '() all-tests-registry)
(set! sorted-testnames (tests:sort-by-priority-and-waiton test-records))
;; refer to (d:alldat-keys *alldat*), (d:alldat-dbkeys *alldat*) for keys
(iup:vbox
(dcommon:command-execution-control data)
(iup:split
#:orientation "VERTICAL" ;; "HORIZONTAL"
#:value 300
;;
;; (iup:split
;; #:value 300
;; Target, testpatt, state and status input boxes
;;
(iup:vbox
;; Command to run, placed over the top of the canvas
(dcommon:command-action-selector data)
(dcommon:command-runname-selector alldat data)
(dcommon:command-testname-selector alldat data update-keyvals key-listboxes))
(dcommon:command-tests-tasks-canvas data test-records sorted-testnames tests-draw-state))
;;(iup:frame
;; #:title "Logs" ;; To be replaced with tabs
;; (let ((logs-tb (iup:textbox #:expand "YES"
;; #:multiline "YES")))
;; (dboard:data-set-logs-textbox! data logs-tb)
;; logs-tb))
)))
;;======================================================================
;; R U N C O N T R O L S
;;======================================================================
;;
;; A gui for launching tests
;;
(define (dashboard:run-times alldat)
(let* ((data (make-vector 25 #f))
(targets (make-hash-table))
(test-records (make-hash-table))
(all-tests-registry (tests:get-all)) ;; (tests:get-valid-tests *toppath* '()))
(test-names (hash-table-keys all-tests-registry))
(sorted-testnames #f)
(action "-run")
(cmdln "")
(runlogs (make-hash-table))
(key-listboxes #f)
(updater-for-runs #f)
(update-keyvals (lambda ()
(let ((targ (map (lambda (x)
(iup:attribute x "VALUE"))
(car (dashboard:update-target-selector key-listboxes))))
(curr-runname (dboard:data-get-run-name data)))
(dboard:data-set-target! data targ)
(if updater-for-runs (updater-for-runs))
(if (or (not (equal? curr-runname (dboard:data-get-run-name data)))
(equal? (dboard:data-get-run-name data) ""))
(dboard:data-set-run-name! data curr-runname))
(dashboard:update-run-command data))))
(tests-draw-state (make-hash-table)) ;; use for keeping state of the test canvas
(test-patterns-textbox #f))
(hash-table-set! tests-draw-state 'first-time #t)
;; (hash-table-set! tests-draw-state 'scalef 1)
(tests:get-full-data test-names test-records '() all-tests-registry)
(set! sorted-testnames (tests:sort-by-priority-and-waiton test-records))
;; refer to (d:alldat-keys *alldat*), (d:alldat-dbkeys *alldat*) for keys
(iup:vbox
(dcommon:command-execution-control data)
(iup:split
#:orientation "VERTICAL" ;; "HORIZONTAL"
#:value 200
;; (iup:split
;; #:value 300
;; Target, testpatt, state and status input boxes
;;
(iup:vbox
;; Command to run, placed over the top of the canvas
(dcommon:command-action-selector data)
(dcommon:command-runname-selector alldat data)
(dcommon:command-testname-selector alldat data update-keyvals key-listboxes))
(dcommon:command-tests-tasks-canvas data test-records sorted-testnames tests-draw-state))
;; (iup:frame
;; #:title "Logs" ;; To be replaced with tabs
;; (let ((logs-tb (iup:textbox #:expand "YES"
;; #:multiline "YES")))
;; (dboard:data-set-logs-textbox! data logs-tb)
;; logs-tb))
)))
;;======================================================================
;; S U M M A R Y
;;======================================================================
;;
;; General info about the run(s) and megatest area
(define (dashboard:summary data)
|
| ︙ | ︙ | |||
1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 | #:expand "HORIZONTAL" #:max (* 10 (length (d:alldat-allruns data))) #:min 0 #:step 0.01))) ;(iup:button "inc rows" #:action (lambda (obj)(d:alldat-num-tests-set! data (+ (d:alldat-num-tests data) 1)))) ;(iup:button "dec rows" #:action (lambda (obj)(d:alldat-num-tests-set! data (if (> (d:alldat-num-tests data) 0)(- (d:alldat-num-tests data) 1) 0)))) )) (define (make-dashboard-buttons data nruns ntests keynames runs-sum-dat new-view-dat) (let* ((db (d:alldat-dblocal data)) (nkeys (length keynames)) (runsvec (make-vector nruns)) (header (make-vector nruns)) (lftcol (make-vector ntests)) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 |
#:expand "HORIZONTAL"
#:max (* 10 (length (d:alldat-allruns data)))
#:min 0
#:step 0.01)))
;(iup:button "inc rows" #:action (lambda (obj)(d:alldat-num-tests-set! data (+ (d:alldat-num-tests data) 1))))
;(iup:button "dec rows" #:action (lambda (obj)(d:alldat-num-tests-set! data (if (> (d:alldat-num-tests data) 0)(- (d:alldat-num-tests data) 1) 0))))
))
(define (dashboard:popup-menu buttndat run-id test-id target runname test-name testpatt)
(iup:menu
(iup:menu-item
"Run"
(iup:menu
(iup:menu-item
(conc "Rerun " testpatt)
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -run -target " target
" -runname " runname
" -testpatt " testpatt
" -preclean -clean-cache")
)))))
(iup:menu-item
"Test"
(iup:menu
(iup:menu-item
(conc "Rerun " test-name)
#:action
(lambda (obj)
(common:run-a-command
(conc "megatest -run -target " target
" -runname " runname
" -testpatt " test-name
" -preclean -clean-cache"))))
(iup:menu-item
"Start xterm"
#:action
(lambda (obj)
(let* ((cmd (conc toolpath " -xterm " run-id "," test-id "&")))
(system cmd))))
(iup:menu-item
"Edit testconfig"
#:action
(lambda (obj)
(let* ((all-tests (tests:get-all))
(editor-rx (or (configf:lookup *configdat* "setup" "editor-regex")
"\\b(vim?|nano|pico)\\b"))
(editor (or (configf:lookup *configdat* "setup" "editor")
(get-environment-variable "VISUAL")
(get-environment-variable "EDITOR") "vi"))
(tconfig (conc (hash-table-ref all-tests test-name) "/testconfig"))
(cmd (conc (if (string-search editor-rx editor)
(conc "xterm -e " editor)
editor)
" " tconfig " &")))
(system cmd))))
))))
(define (make-dashboard-buttons data nruns ntests keynames runs-sum-dat new-view-dat)
(let* ((db (d:alldat-dblocal data))
(nkeys (length keynames))
(runsvec (make-vector nruns))
(header (make-vector nruns))
(lftcol (make-vector ntests))
|
| ︙ | ︙ | |||
1845 1846 1847 1848 1849 1850 1851 |
(else
(let* ((button-key (mkstr runnum testnum))
(butn (iup:button
"" ;; button-key
#:size "60x15"
#:expand "HORIZONTAL"
#:fontsize "10"
| < < < < < < < < | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 |
(else
(let* ((button-key (mkstr runnum testnum))
(butn (iup:button
"" ;; button-key
#:size "60x15"
#:expand "HORIZONTAL"
#:fontsize "10"
#:button-cb
(lambda (obj a pressed x y btn . rem)
;; (print "pressed= " pressed " x= " x " y= " y " rem=" rem " btn=" btn " string? " (string? btn))
(if (substring-index "3" btn)
(if (eq? pressed 1)
(let* ((toolpath (car (argv)))
(buttndat (hash-table-ref (d:alldat-buttondat *alldat*) button-key))
(test-id (db:test-get-id (vector-ref buttndat 3)))
(run-id (db:test-get-run_id (vector-ref buttndat 3)))
(run-info (rmt:get-run-info run-id))
(target (rmt:get-target run-id))
(runname (db:get-value-by-header (db:get-rows run-info)
(db:get-header run-info) "runname"))
(test-name (db:test-get-testname (rmt:get-test-info-by-id run-id test-id)))
(testpatt (let ((tlast (rmt:tasks-get-last target runname)))
(if tlast
(let ((tpatt (tasks:task-get-testpatt tlast)))
(if (member tpatt '("0" 0)) ;; known bad historical value - remove in 2017
"%"
tpatt))
"%"))))
(iup:show (dashboard:popup-menu buttndat run-id test-id target runname test-name testpatt) ;; popup-menu
#:x 'mouse
#:y 'mouse
#:modal? "NO")
;; (print "got here")
))
(if (eq? pressed 0)
(let* ((toolpath (car (argv)))
|
| ︙ | ︙ | |||
1964 1965 1966 1967 1968 1969 1970 | #:tabchangepos-cb (lambda (obj curr prev) (d:alldat-please-update-set! *alldat* #t) (d:alldat-curr-tab-num-set! *alldat* curr)) (dashboard:summary *alldat*) runs-view (dashboard:one-run db data runs-sum-dat) ;; (dashboard:new-view db data new-view-dat) | | | | 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 | #:tabchangepos-cb (lambda (obj curr prev) (d:alldat-please-update-set! *alldat* #t) (d:alldat-curr-tab-num-set! *alldat* curr)) (dashboard:summary *alldat*) runs-view (dashboard:one-run db data runs-sum-dat) ;; (dashboard:new-view db data new-view-dat) (dashboard:run-controls *alldat*) (dashboard:run-times *alldat*) ))) ;; (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 [05bf078426] to [3faddec3ed].
| ︙ | ︙ | |||
62 63 64 65 66 67 68 69 70 71 72 73 74 75 |
(define (dboard:data-get-command-tb vec) (vector-ref vec 17))
(define (dboard:data-get-target vec) (vector-ref vec 18))
(define (dboard:data-get-target-string vec)
(let ((targ (dboard:data-get-target vec)))
(if (list? targ)(string-intersperse targ "/") "no-target-specified")))
(define (dboard:data-get-run-name vec) (vector-ref vec 19))
(define (dboard:data-get-runs-listbox vec) (vector-ref vec 20))
(defstruct d:data runs tests runs-matrix tests-tree run-keys
curr-test-ids updaters path-run-ids curr-run-id runs-tree test-patts
states statuses logs-textbox command command-tb target run-name
runs-listbox)
(define (dboard:data-set-runs! vec val)(vector-set! vec 0 val))
| > | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
(define (dboard:data-get-command-tb vec) (vector-ref vec 17))
(define (dboard:data-get-target vec) (vector-ref vec 18))
(define (dboard:data-get-target-string vec)
(let ((targ (dboard:data-get-target vec)))
(if (list? targ)(string-intersperse targ "/") "no-target-specified")))
(define (dboard:data-get-run-name vec) (vector-ref vec 19))
(define (dboard:data-get-runs-listbox vec) (vector-ref vec 20))
(define (dboard:data-get-updater-for-runs vec) (vector-ref vec 21))
(defstruct d:data runs tests runs-matrix tests-tree run-keys
curr-test-ids updaters path-run-ids curr-run-id runs-tree test-patts
states statuses logs-textbox command command-tb target run-name
runs-listbox)
(define (dboard:data-set-runs! vec val)(vector-set! vec 0 val))
|
| ︙ | ︙ | |||
91 92 93 94 95 96 97 98 99 100 101 102 103 104 | (define (dboard:data-set-statuses! vec val)(vector-set! vec 14 val)) (define (dboard:data-set-logs-textbox! vec val)(vector-set! vec 15 val)) (define (dboard:data-set-command! vec val)(vector-set! vec 16 val)) (define (dboard:data-set-command-tb! vec val)(vector-set! vec 17 val)) (define (dboard:data-set-target! vec val)(vector-set! vec 18 val)) (define (dboard:data-set-run-name! vec val)(vector-set! vec 19 val)) (define (dboard:data-set-runs-listbox! vec val)(vector-set! vec 20 val)) (dboard:data-set-run-keys! *data* (make-hash-table)) ;; List of test ids being viewed in various panels (dboard:data-set-curr-test-ids! *data* (make-hash-table)) ;; Look up test-ids by (key1 key2 ... testname [itempath]) | > | 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | (define (dboard:data-set-statuses! vec val)(vector-set! vec 14 val)) (define (dboard:data-set-logs-textbox! vec val)(vector-set! vec 15 val)) (define (dboard:data-set-command! vec val)(vector-set! vec 16 val)) (define (dboard:data-set-command-tb! vec val)(vector-set! vec 17 val)) (define (dboard:data-set-target! vec val)(vector-set! vec 18 val)) (define (dboard:data-set-run-name! vec val)(vector-set! vec 19 val)) (define (dboard:data-set-runs-listbox! vec val)(vector-set! vec 20 val)) (define (dboard:data-set-updater-for-runs! vec val)(vector-set! vec 21 val)) (dboard:data-set-run-keys! *data* (make-hash-table)) ;; List of test ids being viewed in various panels (dboard:data-set-curr-test-ids! *data* (make-hash-table)) ;; Look up test-ids by (key1 key2 ... testname [itempath]) |
| ︙ | ︙ | |||
940 941 942 943 944 945 946 |
;; (iup:label "Command to run" #:expand "HORIZONTAL" #:size "70x" #:alignment "LEFT:ACENTER")
(let* ((cmds-list '("run" "remove-runs" "set-state-status" "lock-runs" "unlock-runs"))
(lb (iup:listbox #:expand "HORIZONTAL"
#:dropdown "YES"
#:action (lambda (obj val index lbstate)
;; (print obj " " val " " index " " lbstate)
(dboard:data-set-command! data val)
| | | | | | | | 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 |
;; (iup:label "Command to run" #:expand "HORIZONTAL" #:size "70x" #:alignment "LEFT:ACENTER")
(let* ((cmds-list '("run" "remove-runs" "set-state-status" "lock-runs" "unlock-runs"))
(lb (iup:listbox #:expand "HORIZONTAL"
#:dropdown "YES"
#:action (lambda (obj val index lbstate)
;; (print obj " " val " " index " " lbstate)
(dboard:data-set-command! data val)
(dashboard:update-run-command data))))
(default-cmd (car cmds-list)))
(iuplistbox-fill-list lb cmds-list selected-item: default-cmd)
(dboard:data-set-command! data default-cmd)
lb))))
(define (dcommon:command-runname-selector alldat data)
(iup:frame
#:title "Runname"
(let* ((default-run-name (seconds->work-week/day (current-seconds)))
(tb (iup:textbox #:expand "HORIZONTAL"
#:action (lambda (obj val txt)
;; (print "obj: " obj " val: " val " unk: " unk)
(dboard:data-set-run-name! data txt) ;; (iup:attribute obj "VALUE"))
(dashboard:update-run-command data))
#:value (or default-run-name (dboard:data-get-run-name data))))
(lb (iup:listbox #:expand "HORIZONTAL"
#:dropdown "YES"
#:action (lambda (obj val index lbstate)
(if (not (equal? val ""))
(begin
(iup:attribute-set! tb "VALUE" val)
(dboard:data-set-run-name! data val)
(dashboard:update-run-command data))))))
(refresh-runs-list (lambda ()
(let* ((target (dboard:data-get-target-string data))
(runs-for-targ (if (d:alldat-useserver alldat)
(rmt:get-runs-by-patt (d:alldat-keys alldat) "%" target #f #f #f)
(db:get-runs-by-patt (d:alldat-dblocal alldat) (d:alldat-keys alldat) "%" target #f #f #f)))
(runs-header (vector-ref runs-for-targ 0))
(runs-dat (vector-ref runs-for-targ 1))
(run-names (cons default-run-name
(map (lambda (x)
(db:get-value-by-header x runs-header "runname"))
runs-dat))))
;; (iup:attribute-set! lb "REMOVEITEM" "ALL")
(iuplistbox-fill-list lb run-names selected-item: default-run-name)))))
(dboard:data-set-updater-for-runs! data refresh-runs-list)
(refresh-runs-list)
(dboard:data-set-run-name! data default-run-name)
(iup:hbox
tb
lb))))
(define (dcommon:command-testname-selector alldat data update-keyvals key-listboxes)
(iup:frame
#: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:data-set-test-patts!
*data*
(dboard:lines->test-patt b))
(dashboard:update-run-command data))
#:value (dboard:test-patt->lines
(dboard:data-get-test-patts *data*))
#:expand "YES"
#:size "x50"
#:multiline "YES")))
(set! test-patterns-textbox tb)
tb))
|
| ︙ | ︙ | |||
1021 1022 1023 1024 1025 1026 1027 |
(iup:frame
#:title "States"
(dashboard:text-list-toggle-box
;; Move these definitions to common and find the other useages and replace!
(map cadr *common:std-states*) ;; '("COMPLETED" "RUNNING" "STUCK" "INCOMPLETE" "LAUNCHED" "REMOTEHOSTSTART" "KILLED")
(lambda (all)
(dboard:data-set-states! *data* all)
| | | | 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 |
(iup:frame
#:title "States"
(dashboard:text-list-toggle-box
;; Move these definitions to common and find the other useages and replace!
(map cadr *common:std-states*) ;; '("COMPLETED" "RUNNING" "STUCK" "INCOMPLETE" "LAUNCHED" "REMOTEHOSTSTART" "KILLED")
(lambda (all)
(dboard:data-set-states! *data* all)
(dashboard:update-run-command data))))
;; Text box for STATES
(iup:frame
#:title "Statuses"
(dashboard:text-list-toggle-box
(map cadr *common:std-statuses*) ;; '("PASS" "FAIL" "n/a" "CHECK" "WAIVED" "SKIP" "DELETED" "STUCK/DEAD")
(lambda (all)
(dboard:data-set-statuses! *data* all)
(dashboard:update-run-command data))))))))
(define (dcommon:command-tests-tasks-canvas data test-records sorted-testnames tests-draw-state)
(iup:frame
#:title "Tests and Tasks"
(let* ((updater #f)
(last-xadj 0)
(last-yadj 0)
|
| ︙ | ︙ | |||
1102 1103 1104 1105 1106 1107 1108 | (newpatt-list (if selected (cons test-name patterns) (delete test-name patterns))) (newpatt (string-intersperse newpatt-list "\n"))) (iup:attribute-set! obj "REDRAW" "ALL") (hash-table-set! selected-tests test-name selected) (iup:attribute-set! test-patterns-textbox "VALUE" newpatt) | | | | 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 |
(newpatt-list (if selected
(cons test-name patterns)
(delete test-name patterns)))
(newpatt (string-intersperse newpatt-list "\n")))
(iup:attribute-set! obj "REDRAW" "ALL")
(hash-table-set! selected-tests test-name selected)
(iup:attribute-set! test-patterns-textbox "VALUE" newpatt)
(dboard:data-set-test-patts! data (dboard:lines->test-patt newpatt))
(dashboard:update-run-command data)
(if updater (updater last-xadj last-yadj)))))))
(hash-table-keys tests-info)))))))
canvas-obj)))
;;======================================================================
;; S T E P S
;;======================================================================
|
| ︙ | ︙ |