| ︙ | | | ︙ | |
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
|
(if (eq? tstate 0)
(hash-table-delete! alltgls item)
(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))
""
|
|
|
|
|
|
|
|
|
|
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
|
(if (eq? tstate 0)
(hash-table-delete! alltgls item)
(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-command-tb data))
(cmd (dboard:data-command data))
(test-patt (let ((tp (dboard:data-test-patts data)))
(if (equal? tp "") "%" tp)))
(states (dboard:data-states data))
(statuses (dboard:data-statuses data))
(target (let ((targ-list (dboard:data-target data)))
(if targ-list (string-intersperse targ-list "/") "no-target-selected")))
(run-name (dboard:data-run-name data))
(states-str (if (or (not states)
(null? states))
""
(conc " -state " (string-intersperse states ","))))
(statuses-str (if (or (not statuses)
(null? statuses))
""
|
| ︙ | | | ︙ | |
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
|
(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))
|
|
|
|
|
|
|
|
|
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
|
(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-run-name data)))
(dboard:data-target-set! data targ)
(if (dboard:data-updater-for-runs data)
((dboard:data-updater-for-runs data)))
(if (or (not (equal? curr-runname (dboard:data-run-name data)))
(equal? (dboard:data-run-name data) ""))
(dboard:data-run-name-set! 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))
|
| ︙ | | | ︙ | |
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
|
(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
;;======================================================================
;;
|
|
|
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
|
(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-logs-textbox-set! data logs-tb)
;; logs-tb))
)))
;;======================================================================
;; R U N C O N T R O L S
;;======================================================================
;;
|
| ︙ | | | ︙ | |
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
|
(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))
|
|
|
|
|
|
|
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
|
(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-run-name data)))
(dboard:data-target-set! data targ)
(if updater-for-runs (updater-for-runs))
(if (or (not (equal? curr-runname (dboard:data-run-name data)))
(equal? (dboard:data-run-name data) ""))
(dboard:data-run-name-set! 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))
|
| ︙ | | | ︙ | |
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
|
(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
;;======================================================================
;;
|
|
|
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
|
(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-logs-textbox-set! data logs-tb)
;; logs-tb))
)))
;;======================================================================
;; S U M M A R Y
;;======================================================================
;;
|
| ︙ | | | ︙ | |
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
|
(run-name (db:get-value-by-header run-record runs-header "runname"))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
(run-path (append key-vals (list run-name)))
(existing (tree:find-node tb run-path)))
(if (not (hash-table-ref/default (d:data-path-run-ids ddata) run-path #f))
(begin
(hash-table-set! (d:data-run-keys ddata) run-id run-path)
;; (iup:attribute-set! (dboard:data-get-runs-matrix *data*)
;; (conc rownum ":" colnum) col-name)
;; (hash-table-set! runid-to-col run-id (list colnum run-record))
;; Here we update the tests treebox and tree keys
(tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
userdata: (conc "run-id: " run-id))
(hash-table-set! (d:data-path-run-ids ddata) run-path run-id)
;; (set! colnum (+ colnum 1))
|
|
|
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
|
(run-name (db:get-value-by-header run-record runs-header "runname"))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
(run-path (append key-vals (list run-name)))
(existing (tree:find-node tb run-path)))
(if (not (hash-table-ref/default (d:data-path-run-ids ddata) run-path #f))
(begin
(hash-table-set! (d:data-run-keys ddata) run-id run-path)
;; (iup:attribute-set! (dboard:data-runs-matrix data)
;; (conc rownum ":" colnum) col-name)
;; (hash-table-set! runid-to-col run-id (list colnum run-record))
;; Here we update the tests treebox and tree keys
(tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
userdata: (conc "run-id: " run-id))
(hash-table-set! (d:data-path-run-ids ddata) run-path run-id)
;; (set! colnum (+ colnum 1))
|
| ︙ | | | ︙ | |
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
|
(run-name (db:get-value-by-header run-record runs-header "runname"))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
(run-path (append key-vals (list run-name)))
(existing (tree:find-node tb run-path)))
(if (not (hash-table-ref/default (d:data-path-run-ids ddata) run-path #f))
(begin
(hash-table-set! (d:data-run-keys ddata) run-id run-path)
;; (iup:attribute-set! (dboard:data-get-runs-matrix *data*)
;; (conc rownum ":" colnum) col-name)
;; (hash-table-set! runid-to-col run-id (list colnum run-record))
;; Here we update the tests treebox and tree keys
(tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
userdata: (conc "run-id: " run-id))
(hash-table-set! (d:data-path-run-ids ddata) run-path run-id)
;; (set! colnum (+ colnum 1))
|
|
|
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
|
(run-name (db:get-value-by-header run-record runs-header "runname"))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
(run-path (append key-vals (list run-name)))
(existing (tree:find-node tb run-path)))
(if (not (hash-table-ref/default (d:data-path-run-ids ddata) run-path #f))
(begin
(hash-table-set! (d:data-run-keys ddata) run-id run-path)
;; (iup:attribute-set! (dboard:data-runs-matrix data)
;; (conc rownum ":" colnum) col-name)
;; (hash-table-set! runid-to-col run-id (list colnum run-record))
;; Here we update the tests treebox and tree keys
(tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name))
userdata: (conc "run-id: " run-id))
(hash-table-set! (d:data-path-run-ids ddata) run-path run-id)
;; (set! colnum (+ colnum 1))
|
| ︙ | | | ︙ | |