Megatest

Check-in [3947694200]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:guarded against empty run name and no target selected in Run Control.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-revolution
Files: files | file ages | folders
SHA1: 3947694200b25a9e8bef5252418cb41a4c025aba
User & Date: mmgraham on 2024-01-19 22:10:43
Other Links: branch diff | manifest | tags
Context
2024-01-22
11:15
Reordered logic in tt:client-connect-to-server, changed sleep after starting server from 3 to 6 seconds. check-in: 85f3eeb353 user: mmgraham tags: v1.80-revolution
2024-01-19
22:10
guarded against empty run name and no target selected in Run Control. check-in: 3947694200 user: mmgraham tags: v1.80-revolution
08:53
fixed-fork check-in: 1e9f9c66b3 user: mrwellan tags: v1.80-revolution
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard.scm from [d070a63110] to [a25a6de51e].

︙
1423
1424
1425
1426
1427
1428
1429
1430





1431
1432
1433
1434
1435
1436
1437

1423
1424
1425
1426
1427
1428
1429

1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441








-
+
+
+
+
+








                                 (equal? tp ""))
                             "%"
                             tp)))
	 (states       (dboard:tabdat-states     tabdat))
	 (statuses     (dboard:tabdat-statuses   tabdat))
	 (target       (let ((targ-list (dboard:tabdat-target     tabdat)))
			 (if targ-list (string-intersperse targ-list "/") "no-target-selected")))
	 (run-name     (dboard:tabdat-run-name   tabdat))
	 (run-name     (let ((run-input (dboard:tabdat-run-name   tabdat))
                             )
                         (if (equal? run-input "")
                           "no-runname-specified"
                           run-input)))
	 (states-str   (if (or (not states)
			       (null? states))
			   ""
			   (conc " -state "  (string-intersperse states ","))))
	 (statuses-str (if (or (not statuses)
			       (null? statuses))
			   ""
︙

Modified dcommon.scm from [b45e4a62f7] to [987d3903d0].

︙
1136
1137
1138
1139
1140
1141
1142

1143
1144
1145
1146















1147
1148
1149
1150
1151
1152
1153

1136
1137
1138
1139
1140
1141
1142
1143
1144
1145


1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167








+


-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








	       #:value "megatest "
	       #:expand "HORIZONTAL"
	       #:readonly "YES"
	       #:font "Courier New, -12"
	       )))
      (dboard:tabdat-command-tb-set! data tb)
      tb)

    (iup:button "Execute" #:size "50x"
		#:action (lambda (obj)
			   ;; (let ((cmd (conc ;; "xterm -geometry 180x20 -e \""
                           (common:run-a-command (iup:attribute (dboard:tabdat-command-tb data) "VALUE")))))))
			 (let ((cmd (iup:attribute (dboard:tabdat-command-tb data) "VALUE")))
                           (if (substring-index "no-runname-specified" cmd)
                            (debug:print 0 *default-log-port* "ERROR: no runname specified")
                            (begin
                              (if (substring-index "no-target-selected" cmd)
                                (debug:print 0 *default-log-port* "ERROR: no target selected")
                                (begin
                                  (if (not (substring-index "-run" cmd))
                                    (debug:print 0 *default-log-port*  "ERROR: No target selected")
                                    (common:run-a-command (iup:attribute (dboard:tabdat-command-tb data) "VALUE"))
                                  )
                                )
                              )
                            )
                           )))))))
    ;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
    ;; (system cmd)))))))

(define (dcommon:command-action-selector commondat tabdat #!key (tab-num #f))
  (iup:frame
   #:title "Set the action to take"
   (iup:hbox
︙
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182

1182
1183
1184
1185
1186
1187
1188

1189
1190
1191
1192
1193
1194
1195








-








  (iup:frame
   #:title "Runname"
   (let* ((default-run-name (seconds->work-week/day (current-seconds)))
	  (tb (iup:textbox #:expand "HORIZONTAL"
			   #:action (lambda (obj val txt)
				      (debug:catch-and-dump
				       (lambda ()
					 ;; (print "obj: " obj " val: " val " unk: " unk)
					 (dboard:tabdat-run-name-set! tabdat txt) ;; (iup:attribute obj "VALUE"))
					 (dashboard:update-run-command tabdat))
				       "command-runname-selector tb action"))
			   #:value (or default-run-name (dboard:tabdat-run-name tabdat))))
	  (lb (iup:listbox #:expand "HORIZONTAL"
			   #:dropdown "YES"
			   #:action (lambda (obj val index lbstate)
︙
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208

1207
1208
1209
1210
1211
1212
1213

1214
1215
1216
1217
1218
1219
1220








-








					  (runs-for-targ (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f 0))
					  (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))))
				     ;; (print "DEBUGINFO: run-names=" run-names)
				     ;; (iup:attribute-set! lb "REMOVEITEM" "ALL")
				     (iuplistbox-fill-list lb run-names selected-item: default-run-name))))))
     ;; (dboard:tabdat-updater-for-runs-set! tabdat refresh-runs-list)
     (dboard:commondat-add-updater commondat refresh-runs-list tab-num: tab-num)
     ;; (refresh-runs-list)
     (dboard:tabdat-run-name-set! tabdat default-run-name)
     (iup:hbox
︙

This page was generated in about 0.125s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00