| ︙ | | | ︙ | |
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
#:numlin (length key-vals)
#:numcol-visible 1
#:numlin-visible (length key-vals)
#:click-cb (lambda (obj lin col status)
(print "obj: " obj " lin: " lin " col: " col " status: " status)))))
(iup:attribute-set! keys-matrix "0:0" "Run Keys")
(iup:attribute-set! keys-matrix "0:1" "Key Name")
(iup:attribute-set! keys-matrix "WIDTH1" "100")
;; fill in keys
(for-each
(lambda (var)
;; (iup:attribute-set! keys-matrix "ADDLIN" (conc curr-row-num))
(iup:attribute-set! keys-matrix (conc curr-row-num ":0") curr-row-num)
(iup:attribute-set! keys-matrix (conc curr-row-num ":1") var)
(set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var)))
|
|
|
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
#:numlin (length key-vals)
#:numcol-visible 1
#:numlin-visible (length key-vals)
#:click-cb (lambda (obj lin col status)
(print "obj: " obj " lin: " lin " col: " col " status: " status)))))
(iup:attribute-set! keys-matrix "0:0" "Run Keys")
(iup:attribute-set! keys-matrix "0:1" "Key Name")
;; (iup:attribute-set! keys-matrix "WIDTH1" "100")
;; fill in keys
(for-each
(lambda (var)
;; (iup:attribute-set! keys-matrix "ADDLIN" (conc curr-row-num))
(iup:attribute-set! keys-matrix (conc curr-row-num ":0") curr-row-num)
(iup:attribute-set! keys-matrix (conc curr-row-num ":1") var)
(set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var)))
|
| ︙ | | | ︙ | |
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
#:numcol 1
#:numlin (length key-vals)
#:numcol-visible 1
#:numlin-visible (length key-vals)
#:scrollbar "YES")))
(iup:attribute-set! section-matrix "0:0" varcolname)
(iup:attribute-set! section-matrix "0:1" valcolname)
(iup:attribute-set! section-matrix "WIDTH1" "300")
;; fill in keys
(for-each
(lambda (var)
;; (iup:attribute-set! keys-matrix "ADDLIN" (conc curr-row-num))
(iup:attribute-set! section-matrix (conc curr-row-num ":0") var)
(iup:attribute-set! section-matrix (conc curr-row-num ":1") (configf:lookup rawconfig sectionname var))
(set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var)))
|
|
|
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
#:numcol 1
#:numlin (length key-vals)
#:numcol-visible 1
#:numlin-visible (length key-vals)
#:scrollbar "YES")))
(iup:attribute-set! section-matrix "0:0" varcolname)
(iup:attribute-set! section-matrix "0:1" valcolname)
(iup:attribute-set! section-matrix "WIDTH1" "200")
;; fill in keys
(for-each
(lambda (var)
;; (iup:attribute-set! keys-matrix "ADDLIN" (conc curr-row-num))
(iup:attribute-set! section-matrix (conc curr-row-num ":0") var)
(iup:attribute-set! section-matrix (conc curr-row-num ":1") (configf:lookup rawconfig sectionname var))
(set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var)))
|
| ︙ | | | ︙ | |
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
(let ((general-matrix (iup:matrix
#:alignment1 "ALEFT"
#:expand "YES" ;; "HORIZONTAL"
#:numcol 1
#:numlin 3
#:numcol-visible 1
#:numlin-visible 3)))
(iup:attribute-set! general-matrix "WIDTH1" "300")
(iup:attribute-set! general-matrix "0:1" "About this Megatest area")
;; User (this is not always obvious - it is common to run as a different user
(iup:attribute-set! general-matrix "1:0" "User")
(iup:attribute-set! general-matrix "1:1" (current-user-name))
;; Megatest area
(iup:attribute-set! general-matrix "2:0" "Megatest area")
(iup:attribute-set! general-matrix "2:1" *toppath*)
;; Megatest version
(iup:attribute-set! general-matrix "3:0" "Megatest version")
(iup:attribute-set! general-matrix "3:1" megatest-version)
general-matrix))
(define (dcommon:run-stats)
(let* ((run-stats (mt:get-run-stats))
(indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell))
(max-row (apply max (map cadr (car indices))))
(max-col (apply max (map cadr (cadr indices))))
(max-visible (max (- *num-tests* 15) 3))
(stats-matrix (iup:matrix
#:alignment1 "ALEFT"
#:expand "YES" ;; "HORIZONTAL"
#:numcol max-col
#:numlin (if (< max-row max-visible) max-visible max-row) ;; min of 20
#:numcol-visible max-col
#:numlin-visible (if (> max-row max-visible) max-visible max-row)))
(numrows 1)
(numcols 1)
|
|
|
|
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
(let ((general-matrix (iup:matrix
#:alignment1 "ALEFT"
#:expand "YES" ;; "HORIZONTAL"
#:numcol 1
#:numlin 3
#:numcol-visible 1
#:numlin-visible 3)))
(iup:attribute-set! general-matrix "WIDTH1" "200")
(iup:attribute-set! general-matrix "0:1" "About this Megatest area")
;; User (this is not always obvious - it is common to run as a different user
(iup:attribute-set! general-matrix "1:0" "User")
(iup:attribute-set! general-matrix "1:1" (current-user-name))
;; Megatest area
(iup:attribute-set! general-matrix "2:0" "Megatest area")
(iup:attribute-set! general-matrix "2:1" *toppath*)
;; Megatest version
(iup:attribute-set! general-matrix "3:0" "Megatest version")
(iup:attribute-set! general-matrix "3:1" megatest-version)
general-matrix))
(define (dcommon:run-stats)
(let* ((run-stats (mt:get-run-stats))
(indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell))
(max-row (apply max (map cadr (car indices))))
(max-col (apply max (map cadr (cadr indices))))
(max-visible (max (- *num-tests* 15) 3))
(stats-matrix (iup:matrix
;; #:alignment1 "ALEFT"
#:expand "YES" ;; "HORIZONTAL"
#:numcol max-col
#:numlin (if (< max-row max-visible) max-visible max-row) ;; min of 20
#:numcol-visible max-col
#:numlin-visible (if (> max-row max-visible) max-visible max-row)))
(numrows 1)
(numcols 1)
|
| ︙ | | | ︙ | |
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
(debug:print 0 "Extending matrix from " numcols " to " cnum)
(iup:attribute-set! stats-matrix "ADDLIN" (conc numcols "-" (- rnum numcols)))
(set! numcols cnum)))
(debug:print 0 "Setting row " rnum ", col " cnum " to " v)
(iup:attribute-set! stats-matrix (conc rnum ":" cnum) v)))
(row-indices (car indices))
(col-indices (cadr indices)))
;; Row labels
(for-each (lambda (ind)
(let ((name (car ind))
(num (cadr ind)))
(iup:attribute-set! stats-matrix (conc num ":0") name)))
row-indices)
;; Col labels
|
>
|
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
(debug:print 0 "Extending matrix from " numcols " to " cnum)
(iup:attribute-set! stats-matrix "ADDLIN" (conc numcols "-" (- rnum numcols)))
(set! numcols cnum)))
(debug:print 0 "Setting row " rnum ", col " cnum " to " v)
(iup:attribute-set! stats-matrix (conc rnum ":" cnum) v)))
(row-indices (car indices))
(col-indices (cadr indices)))
(iup:attribute-set! stats-matrix "WIDTHDEF" "40")
;; Row labels
(for-each (lambda (ind)
(let ((name (car ind))
(num (cadr ind)))
(iup:attribute-set! stats-matrix (conc num ":0") name)))
row-indices)
;; Col labels
|
| ︙ | | | ︙ | |
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
(col-name (cadr entry))
(value (caddr entry))
(row-num (cadr (assoc row-name row-indices)))
(col-num (cadr (assoc col-name col-indices))))
(iup:attribute-set! stats-matrix (conc row-num ":" col-num) value)))
run-stats)
(iup:vbox
(iup:label "Run statistics" #:expand "HORIZONTAL")
stats-matrix)))
;; The main menu
(define (dcommon:main-menu)
(iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
(iup:menu-item "Files" (iup:menu ;; Note that you can use either #:action or action: for options
(iup:menu-item "Open" action: (lambda (obj)
|
|
|
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
(col-name (cadr entry))
(value (caddr entry))
(row-num (cadr (assoc row-name row-indices)))
(col-num (cadr (assoc col-name col-indices))))
(iup:attribute-set! stats-matrix (conc row-num ":" col-num) value)))
run-stats)
(iup:vbox
(iup:label "Run statistics" #:expand "HORIZONTAL")
stats-matrix)))
;; The main menu
(define (dcommon:main-menu)
(iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
(iup:menu-item "Files" (iup:menu ;; Note that you can use either #:action or action: for options
(iup:menu-item "Open" action: (lambda (obj)
|
| ︙ | | | ︙ | |