︙ | | | ︙ | |
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(use format)
(use (prefix iup iup:))
(use canvas-draw)
(import canvas-draw-iup)
(use sql-de-lite srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors ;; defstruct
(prefix dbi dbi:))
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
;; (declare (uses launch))
;; (declare (uses gutils))
;; (declare (uses db))
;; (declare (uses server))
;; (declare (uses synchash))
(declare (uses dcommon))
;; (declare (uses tree))
;;
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "key_records.scm")
|
>
>
>
>
>
>
|
|
|
<
|
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(declare (uses common))
(declare (uses debugprint))
(declare (uses megatest-version))
(declare (uses mtargs))
(declare (uses commonmod))
(use format)
(use (prefix iup iup:))
(use canvas-draw)
(import canvas-draw-iup)
(use sql-de-lite srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors ;; defstruct
(prefix dbi dbi:))
(import commonmod
debugprint
(prefix mtargs args:))
;; (declare (uses launch))
;; (declare (uses gutils))
;; (declare (uses db))
;; (declare (uses server))
(declare (uses dcommon))
;; (declare (uses tree))
;;
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "key_records.scm")
|
︙ | | | ︙ | |
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
|
#:expand "YES"
;; #:scrollbar "YES"
#:numcol 1
#:numlin 4
#:numcol-visible 1
#:numlin-visible 4
#:click-cb (lambda (obj lin col status)
(print "obj: " obj " lin: " lin " col: " col " status: " status))))
(test-info-matrix (iup:matrix
#:expand "YES"
#:numcol 1
#:numlin 7
#:numcol-visible 1
#:numlin-visible 7))
(test-run-matrix (iup:matrix
|
>
|
>
|
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
|
#:expand "YES"
;; #:scrollbar "YES"
#:numcol 1
#:numlin 4
#:numcol-visible 1
#:numlin-visible 4
#:click-cb (lambda (obj lin col status)
#f
;;(print "obj: " obj " lin: " lin " col: " col " status: " status)
)))
(test-info-matrix (iup:matrix
#:expand "YES"
#:numcol 1
#:numlin 7
#:numcol-visible 1
#:numlin-visible 7))
(test-run-matrix (iup:matrix
|
︙ | | | ︙ | |
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
|
(lambda (obj id state)
;; (print "obj: " obj ", id: " id ", state: " state)
(let* ((run-path (tree:node->path obj id))
(test-id (tree-path->test-id (cdr run-path))))
;; (if test-id
;; (hash-table-set! (dboard:data-curr-test-ids *data*)
;; window-id test-id))
(print "path: " (tree:node->path obj id) " test-id: " test-id))))))
(iup:attribute-set! tb "VALUE" "0")
(iup:attribute-set! tb "NAME" "Runs")
;;(iup:attribute-set! tb "ADDEXPANDED" "NO")
;; (dboard:data-tests-tree-set! *data* tb)
tb)
(test-panel window-id)))
|
|
>
|
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
|
(lambda (obj id state)
;; (print "obj: " obj ", id: " id ", state: " state)
(let* ((run-path (tree:node->path obj id))
(test-id (tree-path->test-id (cdr run-path))))
;; (if test-id
;; (hash-table-set! (dboard:data-curr-test-ids *data*)
;; window-id test-id))
;; (print "path: " (tree:node->path obj id) " test-id: " test-id)
)))))
(iup:attribute-set! tb "VALUE" "0")
(iup:attribute-set! tb "NAME" "Runs")
;;(iup:attribute-set! tb "ADDEXPANDED" "NO")
;; (dboard:data-tests-tree-set! *data* tb)
tb)
(test-panel window-id)))
|
︙ | | | ︙ | |
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
|
;; #:fittosize "YES"
#:scrollbar "YES"
#:numcol 100
#:numlin 100
#:numcol-visible 7
#:numlin-visible 7
#:click-cb (lambda (obj lin col status)
(print "obj: " obj " lin: " lin " col: " col " status: " status)))))
(iup:attribute-set! runs-matrix "RESIZEMATRIX" "YES")
(iup:attribute-set! runs-matrix "WIDTH0" "100")
;; (dboard:data-runs-matrix-set! *data* runs-matrix)
(iup:hbox
(iup:frame
|
>
|
>
|
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
|
;; #:fittosize "YES"
#:scrollbar "YES"
#:numcol 100
#:numlin 100
#:numcol-visible 7
#:numlin-visible 7
#:click-cb (lambda (obj lin col status)
#f
;; (print "obj: " obj " lin: " lin " col: " col " status: " status)
))))
(iup:attribute-set! runs-matrix "RESIZEMATRIX" "YES")
(iup:attribute-set! runs-matrix "WIDTH0" "100")
;; (dboard:data-runs-matrix-set! *data* runs-matrix)
(iup:hbox
(iup:frame
|
︙ | | | ︙ | |