targetui.icl 28.7 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
3
4
5
6
7
implementation module targetui

import StdEnum, StdFunc, StdMisc, StdTuple, StdOrdList
import StdFileSelect, StdMenu, StdMenuElement, StdPStClass, StdSystem
import ExtNotice
import IdeState
import ioutil, tabcontrol
Diederik van Arkel's avatar
Diederik van Arkel committed
8
import UtilStrictLists, UtilIO, PmPath, Platform
Diederik van Arkel's avatar
Diederik van Arkel committed
9
10
11
12
13
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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

/*
	? add 'New' to edit list dlog
	? add 'Copy' to edit list dlog
	? remove 'New...' menu entry
	? add 'error' checking for space in cocl/cg path and subdir in linker paths...
*/

setProjectTarget :: !String !(PSt *General) -> PSt *General
setProjectTarget name ps
	# ps	= appProject (\project -> PR_SetTarget name project) ps
	= ps

getTargetName :: !(PSt *General) -> (String,PSt *General)
getTargetName ps
	# (tgs,ps) = getTargets ps
	# (cur,ps) = getCurrentTarget ps
	= ((tgs!!cur).target_name,ps)

selectProjectTarget :: !(*(PSt *General) -> *([.Target],*(PSt *General))) !*(PSt *General) -> *(PSt *General)
selectProjectTarget getTs ps
	# (name,ps)	= accProject (\p->(PR_GetTarget p,p)) ps
	# (ts,ps)	= getTs ps
	# idx		= findIndex 0 name ts
	| isNothing idx
		| isEmpty ts
			= okNotice ["Unknown environment: "+++name,"No other environments available,","please define one."] ps
		# defname = (ts!!0).target_name
		# ps = appProject (PR_SetTarget defname) ps
		# ps = okTimedNotice ["Unknown environment: "+++name] (ticksPerSecond*4) ps
		= selectProjectTarget getTs ps
	# idx		= fromJust idx
	# ps		= setCurrentTarget idx ps
	# {target_name}	= ts!!idx
	# ps		= setProjectTarget target_name ps
	# ((_,eTargetId),ps) = getTargetIds ps
	# ps		= appPIO ( (selectRadioMenuIndexItem eTargetId (inc idx))) ps
	= ps
where
	findIndex x name [] = Nothing
	findIndex x name [t=:{target_name=n}:ns]
		| n == name = Just x
		= findIndex (inc x) name ns

//--
	
fixAppPaths stup target=:{target_path = path, target_libs = libs, target_objs=objs}
	= {target & target_path = path`, target_libs = libs`, target_objs=objs`}
where
	path` = fulAppPaths stup path
	libs` = fulAppPaths stup libs
	objs` = fulAppPaths stup objs

//--

targetToMenuEntry t=:{target_name}
	= (t.target_name, Nothing, Nothing, noLS (setProjectTarget target_name o setCurrentTarget` t))

targetToMenuEntry` t=:{target_name}
	= (t.target_name, Nothing, Nothing, (setProjectTarget target_name o setCurrentTarget` t))

Diederik van Arkel's avatar
Diederik van Arkel committed
70
71
72
73
74
75
76
77
78
79
80
81
82
83
//:: TargetMenu ls pst	= TargetMenu (Menu (:+: .MenuItem (:+: .MenuItem (:+: .MenuItem (:+: .MenuSeparator .RadioMenu)))) ls *(PSt *General))
:: TargetMenu ls pst
	= TargetMenu 
//	:== 
//		(Menu (:+: .MenuItem (:+: .MenuItem (:+: .MenuSeparator .RadioMenu))) ls pst)
//		(Menu (:+: .MenuItem (:+: .MenuItem (:+: .MenuItem (:+: .MenuSeparator .RadioMenu)))) ls pst)
		(Menu (:+: .MenuItem (:+: .MenuItem (:+: .MenuItem (:+: .MenuItem (:+: .MenuItem (:+: .MenuSeparator .RadioMenu)))))) ls pst)

instance Menus TargetMenu
where
	openMenu ls (TargetMenu mdef) ps	= openMenu ls mdef ps
	getMenuType (TargetMenu mdef)		= "TargetMenu"

targetMenu :: !String [.Target] Id Id (*(PSt *General) -> *([.Target],*(PSt *General))) ([Target] -> .(*(PSt *General) -> *(PSt *General))) -> TargetMenu .a *(PSt *General)
Diederik van Arkel's avatar
Diederik van Arkel committed
84
targetMenu envspath targets mTargetId eTargetId getTargets setTargets
Diederik van Arkel's avatar
Diederik van Arkel committed
85
86
	= TargetMenu 
		(Menu "E&nvironment"
Diederik van Arkel's avatar
Diederik van Arkel committed
87
88
		(	MenuItem "&Edit Current..."		[MenuFunction (noLS editfun)]
		:+: MenuItem "&New ..."				[MenuFunction addtfun]
Diederik van Arkel's avatar
Diederik van Arkel committed
89
90
		:+: MenuItem "&Import..."			[MenuFunction openTarget]
		:+: MenuItem "E&xport..."			[MenuFunction saveTarget]
Diederik van Arkel's avatar
Diederik van Arkel committed
91
92
93
94
95
96
97
98
		:+: MenuItem "Edit &List..."		[MenuFunction (noLS remtfun)]
		:+:	MenuSeparator []
		:+: RadioMenu
			[ targetToMenuEntry t
			\\ t <- targets
			] 1 [MenuId eTargetId]
		)
		[ MenuId mTargetId
Diederik van Arkel's avatar
Diederik van Arkel committed
99
		])
Diederik van Arkel's avatar
Diederik van Arkel committed
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
127
128
129
130
131
132
133
134
135
136
137
138
139
where
	editfun ps
		# ps			= editTargets getTargets setTargets ps
		# (targets,ps)	= getTargets ps
		# (ok,ps)		= saveEnvironments envspath targets ps
		| not ok
			#	ps	= okNotice ["Unable to save environments settings."] ps
			= ps
		= ps
	remtfun ps
		# (targets,ps)	= getTargets ps
		# (lbId,ps)		= openExtListBoxId ps
		# (dId,ps)		= openId ps
		# (okId,ps)		= openId ps
		# (cancelId,ps)	= openId ps
		# ddef			=	ExtListBoxControl
							[toItem t \\ t <- targets]	// contents = targets
							[1]							// initial selection = first item
							(\_ ps -> ps)
							lbId
							[ControlViewSize {w=200,h=100}]
						:+: ButtonControl "Edit..."
							[ControlFunction (editfun` lbId dId)
							,ControlWidth (ContentWidth "Move Down")
							]
						:+:	ButtonControl "Remove"
							[ControlFunction (remfun lbId dId)
							,ControlWidth (ContentWidth "Move Down")
							,ControlPos (BelowPrev,zero)
							]
						:+:	ButtonControl "Copy..."
							[ControlFunction (copyfun lbId dId)
							,ControlWidth (ContentWidth "Move Down")
							,ControlPos (BelowPrev,zero)
							]
						:+:	ButtonControl "Rename..."
							[ControlFunction (renamefun lbId dId)
							,ControlWidth (ContentWidth "Move Down")
							,ControlPos (BelowPrev,zero)
							]
Diederik van Arkel's avatar
Diederik van Arkel committed
140
141
142
143
144
145
146
147
						:+: ButtonControl "Move Up"
							[ControlFunction (upfun lbId)
							,ControlWidth (ContentWidth "Move Down")
							,ControlPos (BelowPrev,zero)]
						:+: ButtonControl "Move Down"
							[ControlFunction (dnfun lbId)
							,ControlWidth (ContentWidth "Move Down")
							,ControlPos (BelowPrev,zero)]
Diederik van Arkel's avatar
Diederik van Arkel committed
148
149
150
151
152
153
						:+:	ButtonControl "OK"
							[ ControlPos (Right,zero)
							, ControlFunction (okfun lbId dId (length targets))
							, ControlWidth (ContentWidth "Cancel")
							, ControlId okId
							]
Diederik van Arkel's avatar
Diederik van Arkel committed
154
155
156
157
158
159
						:+:	ButtonControl "Cancel"
							[ControlPos (LeftOfPrev,zero)
							,ControlFunction (noLS (cancelfun dId))
							,ControlId cancelId
							]
		# datt			= [WindowId dId,WindowOk okId, WindowCancel cancelId,WindowClose (noLS (cancelfun dId))]
Diederik van Arkel's avatar
Diederik van Arkel committed
160
161
162
		# (_,ps)		= openModalDialog targets (Dialog "Edit Environments List" ddef datt) ps
		= ps
	where
Diederik van Arkel's avatar
Diederik van Arkel committed
163
164
165
166
167
168
169
170
		upfun lbId (targets,ps)
			# (_,(targets,ps)) = upSelItem lbId (targets,ps)
			// adjust radio menu...
			= (targets,ps)
		dnfun lbId (targets,ps)
			# (_,(targets,ps)) = dnSelItem lbId (targets,ps)
			// adjust radio menu...
			= (targets,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
		toItem {target_name} = (target_name,id,id)
		editfun` lbId dId (targets,ps)
			# ((ok,sel),ps)	= getExtListBoxSelection lbId ps
			| not ok
				= (targets,ps)
			# sel			= map snd sel
			| isEmpty sel
				= (targets,ps)
			# sel = dec (hd sel)

			# (savetargets,ps) = getTargets ps
			# (savecurrent,ps) = getCurrentTarget ps

			# ps = setTargets targets ps
			# ps = setCurrentTarget sel ps

			# ps = editTargets getTargets setTargets ps

			# (targets,ps) = getTargets ps
			# ps = setTargets savetargets ps
			# ps = setCurrentTarget savecurrent ps
			= (targets,ps)
		remfun lbId dId (targets,ps)
			# ((ok,sel),ps)	= getExtListBoxSelection lbId ps
			| not ok
				= (targets,ps)
			# sel			= map snd sel
			# ps			= closeExtListBoxItems lbId sel ps
			# targets		= remove sel targets
			= (targets,ps)
		where
			remove is ts = remove` 1 (sort is) ts

			remove` _ [] ts = ts
			remove` x [i:is] [t:ts]
				| x > i = abort "target:remove targets: index out of range"
				| x == i = remove` (inc x) is ts
				= [t:remove` (inc x) [i:is] ts]
			remove` _ _ _ = abort "fatal error in remove`"
		copyfun lbId dId (targets,ps)
			# ((ok,sel),ps)	= getExtListBoxSelection lbId ps
			| not ok || isEmpty sel
				= (targets,ps)
			# sel = snd (hd sel)
			# target = targets!!(sel - 1)
			= newNameDialog target.target_name (copycont sel target lbId) (targets,ps)
		copycont sel target lbId target_name (targets,ps)
			# target = {target & target_name = target_name}
219
220
221
222
//			# targets = insertAt (sel-1) target targets
//			# ps	= openExtListBoxItems lbId sel [toItem target] ps
			# targets = insertAt sel target targets
			# ps	= openExtListBoxItems lbId (sel+1) [toItem target] ps
Diederik van Arkel's avatar
Diederik van Arkel committed
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
			= (targets,ps)
		renamefun lbId dId (targets,ps)
			# ((ok,sel),ps)	= getExtListBoxSelection lbId ps
			| not ok || isEmpty sel
				= (targets,ps)
			# sel = snd (hd sel)
			# target = targets!!(sel - 1)
			= newNameDialog target.target_name (renamecont sel target lbId) (targets,ps)
		renamecont sel target lbId target_name (targets,ps)
			# target = {target & target_name = target_name}
			# targets = updateAt (sel-1) target targets
			# ps	= closeExtListBoxItems lbId [sel] ps
			# ps	= openExtListBoxItems lbId sel [toItem target] ps
			= (targets,ps)
		okfun lbId dId last (targets,ps)
			# (ok,ps)		= saveEnvironments envspath targets ps
			| not ok
				#	ps	= okNotice ["Unable to save environments settings."] ps
				= (targets,ps)
			# ps			= appPIO (closeRadioMenuIndexElements eTargetId [1..last]) ps
			# (err,ps)		= accPIO (openRadioMenuItems eTargetId 1
								[targetToMenuEntry` t
								\\ t <- targets
								]) ps
			
			# ps			= setTargets targets ps
249
			# ps			= selectProjectTarget getTargets ps
Diederik van Arkel's avatar
Diederik van Arkel committed
250
251
			# ps			= closeWindow dId ps
			= (targets,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
252
253
		cancelfun dId ps
			= closeWindow dId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
	addtfun (ls,ps)
		= newNameDialog "new environment" cont (ls,ps)
	where
		cont newname (ls,ps)
			# newtarget		= {t_StdEnv & target_name = newname}
			# (app_path,ps)	= getStup ps
			# newtarget		= fixAppPaths app_path newtarget
			# (targets,ps)	= getTargets ps
			# targets		= targets++[newtarget]
			# ps			= setTargets targets ps
			# newindex		= length targets
			# (err,ps)		= accPIO (openRadioMenuItems eTargetId newindex [targetToMenuEntry` newtarget]) ps
			| err <> NoError
				= abort "targetui.icl: strange error adding target"
			# ps			= setProjectTarget newname ps
			# ps			= selectProjectTarget getTargets ps
			# ps			= editTargets getTargets setTargets ps
			# (ok,ps)		= saveEnvironments envspath targets ps
			| not ok
				# ps		= okNotice ["Unable to save environments settings."] ps
				= (ls,ps)
			= (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
	openTarget (ls,ps)
		# (app_path,ps)		= getStup ps
		// select file
		# (envpath,ps)		= selectInputFile ps
		| isNothing envpath	= (ls,ps)
		# envpath			= fromJust envpath
		// read file
		# (newtargets,ps)	= openEnvironments app_path envpath ps
		// add targets
		# newtargets		= map (fixAppPaths app_path) newtargets
		# (targets,ps)		= getTargets ps
		# targets			= targets++newtargets
		# ps				= setTargets targets ps
		# newindex			= length targets
		# (err,ps)			= accPIO (openRadioMenuItems eTargetId newindex (map targetToMenuEntry` newtargets)) ps
		| err <> NoError
			= abort "targetui.icl: strange error adding target"
		# (ok,ps)			= saveEnvironments envspath targets ps
		| not ok
			# ps			= okNotice ["Unable to save environments settings."] ps
			= (ls,ps)
		= (ls,ps)
	saveTarget (ls,ps)
		# (app_path,ps)		= getStup ps
		# (tgs,ps)			= getTargets ps
		# (cur,ps)			= getCurrentTarget ps
		# env				= tgs!!cur
		# envname			= env.target_name
		# envpath			= MakeFullPathname EnvsDir (envname +++ ".env")
		// select file
306
		# (envpath,ps)		= selectOutputFile "Save Environment As..." envpath ps
Diederik van Arkel's avatar
Diederik van Arkel committed
307
308
		| isNothing envpath	= (ls,ps)
		# envpath			= fromJust envpath
309
		# (ok,ps)			= saveEnvironments envpath [env] ps
Diederik van Arkel's avatar
Diederik van Arkel committed
310
311
312
313
		| not ok
			# ps			= okNotice ["Unable to save environment."] ps
			= (ls,ps)
		= (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
314
315
316
//--

newNameDialog ininame cont (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
317
	# (textId,ps)	= openId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
318
319
320
	# (editId,ps)	= openId ps
	# (windId,ps)	= openId ps
	# (okId,ps)		= openId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
321
322
323
	# (cancelId,ps)	= openId ps
	# (ts,ps)		= getTargets ps
	# names			= map (\{target_name}->target_name) ts
Diederik van Arkel's avatar
Diederik van Arkel committed
324
325
	# ((err,en),ps)	= openModalDialog Nothing
						(Dialog "Environment Name"
Diederik van Arkel's avatar
Diederik van Arkel committed
326
327
328
329
						(	TextControl "Enter name for environment"
							[ ControlId textId
							]
						:+:	EditControl ininame (PixelWidth 150) 1
330
							[ ControlId editId
Diederik van Arkel's avatar
Diederik van Arkel committed
331
							, ControlPos (Left,zero)
332
333
							, ControlActivate (noLS (appPIO (setEditControlSelection editId 1 0)))
							]
Diederik van Arkel's avatar
Diederik van Arkel committed
334
						:+: ButtonControl "OK"
Diederik van Arkel's avatar
Diederik van Arkel committed
335
							[ControlPos (Right,zero),ControlFunction (okfun textId editId windId names),ControlId okId]
Diederik van Arkel's avatar
Diederik van Arkel committed
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
						:+: ButtonControl "Cancel"
							[ControlPos (LeftOfPrev,zero),ControlFunction (cancelfun windId),ControlId cancelId]
						)
						[ WindowId windId,WindowClose (cancelfun windId)
						, WindowOk okId
						, WindowCancel cancelId
						]
						) ps
	| err <> NoError
		= (ls,ps)
	| isNothing en
		= (ls,ps)
	| isNothing (fromJust en)
		= (ls,ps)
	= cont (fromJust (fromJust en)) (ls,ps)
where
Diederik van Arkel's avatar
Diederik van Arkel committed
352
	okfun textId editId windId names (_,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
353
354
355
356
357
		# (wstate,ps)		= accPIO (getWindow windId) ps
		| isNothing wstate
			= (Nothing, closeWindow windId ps)
		# wstate			= fromJust wstate
		# (_,maybename)	= getControlText editId wstate
Diederik van Arkel's avatar
Diederik van Arkel committed
358
359
360
361
362
		| isJust maybename && isMember (fromJust maybename) names
			# ps = appPIO (beep o setControlText textId (fromJust maybename +++ " already in use")) ps
//			#! ps = trace_n` ("in use",maybename) ps
			= (maybename, ps)
//		#! ps = trace_n` ("ok",maybename) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
363
364
		= (maybename,closeWindow windId ps)
	cancelfun windId (_,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
365
//		#! ps = trace_n` ("cancel") ps
Diederik van Arkel's avatar
Diederik van Arkel committed
366
		= (Nothing,closeWindow windId ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
367

Diederik van Arkel's avatar
Diederik van Arkel committed
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
//--

setCurrentTarget` t ps
	# (ts,ps) = getTargets ps
	# x = find t ts
	| x < 0
		// silly solution
		= setCurrentTarget 0 ps
	# ps = setCurrentTarget x ps
	= ps
where
	find t ts = find` 0 ts
	where
		find` x [] = (-1)
		find` x [h:ts]
			| t.target_name == h.target_name = x
			= find` (inc x) ts

//--- Environment settings dialog

buttonWidth = ContentWidth "Append..."

editTargets getTs setTs ps
	# (ap,ps) 	= getStup ps
	# (pp,ps) 	= getPath ps
	# pp		= RemoveFilename pp
	# (ts,ps)	= getTs ps
	# (ct,ps)	= getCurrentTarget ps
	# ps		= envDialog ap pp ts ct getTs setTs ps
	= ps

:: LS ps =
	{ tg	:: !Target
	, full	:: !Bool
	, ap	:: !String
	, pp	:: !String
	
	, c1id	:: !Id
	, c2id	:: !Id
	, c3id	:: !Id
	, c4id	:: !Id
	
	, lbsllId	:: !ExtListBoxId ps
	, lblibId	:: !ExtListBoxId ps
	, lbobjId	:: !ExtListBoxId ps
	, lbpadId	:: !ExtListBoxId ps
	}

envDialog ap pp ts ct getTs setTs ps
	# (wid,ps)	= openId ps
	# (okId,ps)	= openId ps
	# (cancelId,ps)	= openId ps
	# (r1id,ps) = openId ps
	# (r2id,ps) = openId ps
	# (r3id,ps) = openId ps
	# (r4id,ps) = openId ps
	# (siz,ps)	= controlSize (LayoutControl
					(	ButtonControl "Append..." [ControlWidth buttonWidth]
					:+: ButtonControl "Remove" [ControlPos (Left,zero),ControlWidth buttonWidth]
					)
					[ ControlPos (Left,zero)
					, ControlHMargin 0 0
					, ControlVMargin 0 0
					])
					True
					Nothing Nothing Nothing ps
	# (lbobjId,ps) = openExtListBoxId ps
	# (lbobj) = ExtListBoxControl
	  				(zip3(StrictListToList(FullPaths inifull ap pp tg.target_objs))(repeat id)(repeat id))
	  				[] 						// initial selection
	  				(\sel ps->case sel of
	  					[]	-> appPIO (disableControl r4id) ps
	  					_	-> appPIO (enableControl r4id) ps
	  				)						// selection update function
	  				lbobjId
	  				[ControlViewSize {h=siz.Size.h,w=300}]
	# (lblibId,ps) = openExtListBoxId ps
	# (lblib) = ExtListBoxControl
	  				(zip3(StrictListToList(FullPaths inifull ap pp tg.target_libs))(repeat id)(repeat id))
	  				[] // initial selection
	  				(\sel ps->case sel of
	  					[]	-> appPIO (disableControl r2id) ps
	  					_	-> appPIO (enableControl r2id) ps
	  				)						// selection update function
	  				lblibId
	  				[ControlViewSize {h=siz.Size.h,w=300}]
	# (lbpadId,ps) = openExtListBoxId ps
	# (lbsllId,ps) = openExtListBoxId ps
	# lbsll = ExtListBoxControl
	  				(zip3(StrictListToList(FullPaths inifull ap pp tg.target_stat))(repeat id)(repeat id))
	  				[] // initial selection
	  				(\sel ps->case sel of
	  					[]	-> appPIO (disableControl r3id) ps
	  					_	-> appPIO (enableControl r3id) ps
	  				)						// selection update function
	  				lbsllId
	  				[ControlViewSize {h=siz.Size.h,w=300}]
	# (compId,ps) = openId ps
	# (cgenId,ps) = openId ps
	# (linkId,ps) = openId ps
	# (dynlId,ps) = openId ps
	# (versId,ps) = openId ps
	# (methId,ps) = openId ps
	# (c1id,ps) = openId ps
	# (c2id,ps) = openId ps
	# (c3id,ps) = openId ps
	# (c4id,ps) = openId ps
	# iniLS =
		{ tg	= tg
		, full	= inifull
		, ap	= ap
		, pp	= pp
		, c1id	= c1id
		, c2id	= c2id
		, c3id	= c3id
		, c4id	= c4id
		, lbpadId	= lbpadId
		, lbobjId	= lbobjId
		, lbsllId	= lbsllId
		, lblibId	= lblibId
		}
	# (_,ps) = openModalDialog iniLS
Diederik van Arkel's avatar
Diederik van Arkel committed
490
				(ddef wid okId cancelId lbobj lbobjId lblib lblibId (siz.Size.h) lbpadId lbsll
Diederik van Arkel's avatar
Diederik van Arkel committed
491
492
493
494
495
496
497
498
				 lbsllId siz compId cgenId linkId dynlId versId methId c1id c2id c3id c4id
				 r1id r2id r3id r4id
				) ps
	= ps
where
	tg = ts!!ct
	inifull = False

Diederik van Arkel's avatar
Diederik van Arkel committed
499
	ddef wid okId cancelId lbobj lbobjId lblib lblibId height lbpadId lbsll lbsllId siz compId cgenId linkId dynlId
Diederik van Arkel's avatar
Diederik van Arkel committed
500
501
502
503
504
505
506
507
		versId methId c1id c2id c3id c4id r1id r2id r3id r4id
		= Dialog ("Environment: "+++tg.target_name)
			(title :+: panes :+: buttons`)
			[WindowId wid, WindowOk okId, WindowClose (noLS (closeWindow wid)), WindowCancel cancelId]
	where
		buttons` = buttons wid okId cancelId getTs setTs ct ts compId cgenId linkId dynlId versId methId
		panes = TabControl
					(	Pane "Tools" (toolpane tg compId cgenId linkId dynlId versId methId)
Diederik van Arkel's avatar
Diederik van Arkel committed
508
					:+: Pane "Paths" (pathpane ap pp tg.target_path inifull height lbpadId c1id r1id)
Diederik van Arkel's avatar
Diederik van Arkel committed
509
510
511
512
513
514
					:+: Pane "Dynamic Libraries" (dlibpane inifull lblib c2id r2id)
					:+: Pane "Static Libraries" (slibpane inifull lbsll c3id r3id)
					:+: Pane "Object Modules" (objmpane inifull lbobj c4id r4id)
					) [ControlPos (Left,zero)]

buttons wid okId cancelId getTs setTs ct ts compId cgenId linkId dynlId versId methId
Diederik van Arkel's avatar
Diederik van Arkel committed
515
	=	ButtonControl "Done"
Diederik van Arkel's avatar
Diederik van Arkel committed
516
517
518
519
		[ ControlFunction savefun
		, ControlId okId, ControlPos (Right,zero)
		, ControlWidth width
		]
Diederik van Arkel's avatar
Diederik van Arkel committed
520
/*	:+: ButtonControl "Save As..."
Diederik van Arkel's avatar
Diederik van Arkel committed
521
522
523
524
		[ ControlFunction saveasfun
		, ControlPos (LeftOfPrev,zero)
		, ControlWidth width
		]
Diederik van Arkel's avatar
Diederik van Arkel committed
525
*/	:+:	ButtonControl "Cancel"
Diederik van Arkel's avatar
Diederik van Arkel committed
526
527
528
529
530
531
532
533
		[ ControlFunction (noLS (closeWindow wid))
		, ControlPos (LeftOfPrev,zero)
		, ControlWidth width
		, ControlId cancelId
		]
where
	width = ContentWidth "Save As..."

Diederik van Arkel's avatar
Diederik van Arkel committed
534
	savefun (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
535
		# (ls,ps)	= commonsave (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
536
		# (tg,ls)	= ls!tg
537
538
		# ps		= setTs (updateAt ct tg ts) ps
		# ps		= setProjectTarget tg.target_name ps
Diederik van Arkel's avatar
Diederik van Arkel committed
539
540
		// possible since we know it's only possible to edit the active environment...
		= (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
541
	saveasfun (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
542
		# (ls,ps)	= commonsave (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
543
		# (tg,ls)	= ls!tg
544
		= newNameDialog tg.target_name contSaveAs (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
545
546
	contSaveAs target_name (ls,ps)
		# ls		= {ls & tg.target_name = target_name}
547
548
		# (tg,ls)	= ls!tg
		# ps		= setTs (ts++[tg]) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
549
		# ((_,eTargetId),ps) = getTargetIds ps
550
		# (err,ps)		= accPIO (openRadioMenuItems eTargetId (1 + length ts) [targetToMenuEntry` tg]) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
		| err <> NoError
			= abort "targetui.icl: strange error adding target in saveas"
		# ps		= setProjectTarget target_name ps
		// possible since we know it's only possible to edit the active environment...
		# ps		= selectProjectTarget getTs ps
		= (ls,ps)


	commonsave (ls,ps)
		# (wdef,ps) = accPIO (getWindow wid) ps
		| isNothing wdef
			= abort "Fatal error in environment dialog: window has disappeared."
		# wdef		= fromJust wdef
		# [(ok1,comp),(ok2,cgen),(ok3,link),(ok4,dynl),(ok5,vers),(ok6,mnum):_]
					= getControlTexts [compId,cgenId,linkId,dynlId,versId,methId] wdef
		| not (ok1 && ok2 && ok3 && ok4 && ok5 && ok6)
			= abort "Fatal error in environment dialog: controls have disappeared."
		| (isNothing comp) || (isNothing cgen) || (isNothing link) || (isNothing dynl)
		|| (isNothing vers) || (isNothing mnum)
			= abort "Fatal error in environment dialog: controls are empty."
		# comp = fromJust comp
		# cgen = fromJust cgen
		# link = fromJust link
		# dynl = fromJust dynl
		# vers = fromJust vers
		# mnum = fromJust mnum
		# ls =
				{ ls
				& tg.target_comp = comp
				, tg.target_cgen = cgen
				, tg.target_link = link
				, tg.target_dynl = dynl
				, tg.target_vers = toInt vers
				}
		# ls = case ls.tg.target_meth of
				(CompileAsync _)	-> {ls & tg.target_meth = CompileAsync (toInt mnum)}
				_					-> ls
		# ps = closeWindow wid ps
		= (ls,ps)

//--

title
	= TextControl "Environment Options" [ControlPos (Center,zero)]

toolpane tg compId cgenId linkId dynlId versId methId
	=	TextControl "Compiler: " [ControlWidth textWidth]
598
599
600
601
	:+: EditControl tg.target_comp (PixelWidth 250) 1
		[ ControlId compId
		, ControlActivate (noLS (appPIO (setEditControlSelection compId 1 0)))
		]
Diederik van Arkel's avatar
Diederik van Arkel committed
602
	:+: TextControl "Generator: " [ControlPos (Left,zero),ControlWidth textWidth]
603
604
605
606
	:+: EditControl tg.target_cgen (PixelWidth 250) 1
		[ ControlId cgenId
		, ControlActivate (noLS (appPIO (setEditControlSelection cgenId 1 0)))
		]
Diederik van Arkel's avatar
Diederik van Arkel committed
607
	:+: TextControl "Static Linker: " [ControlPos (Left,zero),ControlWidth textWidth]
608
609
610
611
	:+: EditControl tg.target_link (PixelWidth 250) 1
		[ ControlId linkId
		, ControlActivate (noLS (appPIO (setEditControlSelection linkId 1 0)))
		]
Diederik van Arkel's avatar
Diederik van Arkel committed
612
	:+: TextControl "Dynamic Linker: " [ControlPos (Left,zero),ControlWidth textWidth]
613
614
615
616
	:+: EditControl tg.target_dynl (PixelWidth 250) 1
		[ ControlId dynlId
		, ControlActivate (noLS (appPIO (setEditControlSelection dynlId 1 0)))
		]
Diederik van Arkel's avatar
Diederik van Arkel committed
617
	:+: TextControl "ABC version: " [ControlPos (Left,zero),ControlWidth textWidth]
618
619
620
621
	:+: EditControl (toString tg.target_vers) (PixelWidth 250) 1
		[ ControlId versId
		, ControlActivate (noLS (appPIO (setEditControlSelection versId 1 0)))
		]
Diederik van Arkel's avatar
Diederik van Arkel committed
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
	:+: CheckControl [("Console in IDE",Nothing,toMark tg.target_redc,redcfun)] (Columns 1) [ControlPos (Left,zero)]
	:+: RadioControl
		[("Sync",Nothing,methfun 1)
		,("Async",Nothing,methfun 2)
		,("Pers",Nothing,methfun 3)
		]
		(Columns 1)
		(case tg.target_meth of
			CompileSync			-> 1
			(CompileAsync _)	-> 2
			CompilePers			-> 3
		)
		[ControlPos (Left,zero)]
	:+: EditControl
		(case tg.target_meth of
			(CompileAsync n)	-> toString n
			_					-> "1"
		)
		(PixelWidth 250) 1
641
642
		[ ControlId methId
		, case tg.target_meth of
Diederik van Arkel's avatar
Diederik van Arkel committed
643
644
			(CompileAsync _)	-> ControlSelectState Able
			_					-> ControlSelectState Unable
645
		, ControlActivate (noLS (appPIO (setEditControlSelection methId 1 0)))
Diederik van Arkel's avatar
Diederik van Arkel committed
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
		]
where
	textWidth = ContentWidth "Dynamic Linker: "

	redcfun (ls,ps)
		# ls = {ls & tg.target_redc = not ls.tg.target_redc}
		= (ls,ps)
	
	methfun 1 (ls,ps)
		# ps = appPIO (disableControl methId) ps
		# ls = {ls & tg.target_meth = CompileSync}
		= (ls,ps)
	methfun 2 (ls,ps)
		# ps = appPIO (enableControl methId) ps
		# num = 42
		# ls = {ls & tg.target_meth = CompileAsync num}
		= (ls,ps)
	methfun 3 (ls,ps)
		# ps = appPIO (disableControl methId) ps
		# ls = {ls & tg.target_meth = CompilePers}
		= (ls,ps)

Diederik van Arkel's avatar
Diederik van Arkel committed
668
pathpane ap pp paths inifull height lbpadId c1id r1id
Diederik van Arkel's avatar
Diederik van Arkel committed
669
670
671
672
673
674
675
676
677
678
679
680
681
	=	TextControl "Paths" []
	:+: LayoutControl
		(	ButtonControl "Append..."
			[ ControlFunction	addPath
			, ControlWidth		buttonWidth
			]
		:+: ButtonControl "Remove"
			[ ControlPos		(Left,zero)
			, ControlFunction	removePath
			, ControlWidth		buttonWidth
			, ControlId			r1id
			, ControlSelectState	Unable
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
682
683
		:+:	ButtonControl "Up" [ControlPos (Left,zero),ControlFunction lbUp]
		:+:	ButtonControl "Dn" [ControlPos (Left,zero),ControlFunction lbDn]
Diederik van Arkel's avatar
Diederik van Arkel committed
684
685
686
687
688
689
690
691
692
		) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
	:+: lbpad
	:+: CheckControl
		[ ("Show Full Names",Nothing,toMark inifull,showFullPaths)
		]
		(Columns 1)
		[ ControlPos (Left,zero)
		, ControlId c1id
		]
Diederik van Arkel's avatar
Diederik van Arkel committed
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
where
	lbpad = ExtListBoxControl
	  				(zip3(StrictListToList(FullPaths inifull ap pp paths))(repeat id)(repeat id))
	  				[]						// initial selection
	  				(\sel ps->case sel of
	  					[]	-> appPIO (disableControl r1id) ps
	  					_	-> appPIO (enableControl r1id) ps
	  				)						// selection update function
	  				lbpadId
	  				[ControlViewSize {h=height,w=300}]
	lbUp (ls,ps)
		# lo = ls.tg.target_path
		# (_,(lo,ps)) = upSelItem lbpadId (StrictListToList lo,ps)
		# lo = ListToStrictList lo
		# ls = {ls & tg.target_path = lo}
		= (ls,ps)
	lbDn (ls,ps)
		# lo = ls.tg.target_path
		# (_,(lo,ps)) = dnSelItem lbpadId (StrictListToList lo,ps)
		# lo = ListToStrictList lo
		# ls = {ls & tg.target_path = lo}
		= (ls,ps)
	addPath (ls=:{tg,full,ap,pp,lbpadId},ps)
		#	(fs,ps)				= selectDirectory` ps
		| isNothing fs = (ls,ps)
		#	pathname			= fromJust fs
			ls					= {ls & tg.target_path = Append tg.target_path pathname}
			ps					= appendExtListBoxItems lbpadId (zip3 [FullPath full ap pp pathname](repeat id)(repeat id)) ps
		= (ls,ps)
	
	removePath (ls=:{tg,ap,pp,lbpadId},ps)
		#	((ok,sel),ps)		= getExtListBoxSelection lbpadId ps
		| not ok || isEmpty sel = (ls,ps)
		#	(pathsel,indexsel)	= unzip sel
			ls					= {ls & tg.target_path = RemoveMembers tg.target_path (ListToStrictList [fulPath ap pp s \\ s <- pathsel])}
			ps					= closeExtListBoxItems lbpadId indexsel ps
			ps					= setExtListBoxSelection lbpadId [] ps
		= (ls,ps)
	
Diederik van Arkel's avatar
Diederik van Arkel committed
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806

dlibpane inifull lblib c2id r2id
	=	TextControl "Dynamic Libraries" []
	:+: LayoutControl
		(	ButtonControl "Append..."
			[ ControlFunction addLibrary
			, ControlWidth buttonWidth
			]
		:+: ButtonControl "Remove"
			[ ControlPos (Left,zero)
			, ControlFunction remLibrary
			, ControlWidth buttonWidth
			, ControlId			r2id
			, ControlSelectState	Unable
			]
		) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
	:+: lblib
	:+: CheckControl
		[ ("Show Full Names",Nothing,toMark inifull,showFullPaths)
		]
		(Columns 1)
		[ ControlPos (Left,zero)
		, ControlId c2id
		]

slibpane inifull lbsll c3id r3id
	= TextControl "Static Libraries" []
	:+: LayoutControl
		(	ButtonControl "Append..."
			[ ControlFunction addStatic
			, ControlWidth buttonWidth
			]
		:+: ButtonControl "Remove"
			[ ControlPos (Left,zero)
			, ControlFunction remStatic
			, ControlWidth buttonWidth
			, ControlId			r3id
			, ControlSelectState	Unable
			]
		) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
	:+: lbsll
	:+: CheckControl
		[ ("Show Full Names",Nothing,toMark inifull,showFullPaths)
		]
		(Columns 1)
		[ ControlPos (Left,zero)
		, ControlId c3id
		]

objmpane inifull lbobj c4id r4id
	=	TextControl "Object Modules" []
	:+: LayoutControl
		(	ButtonControl "Append..."
			[ ControlFunction		addObject
			, ControlWidth			buttonWidth
			]
		:+: ButtonControl "Remove"
			[ ControlPos			(Left,zero)
			, ControlFunction		remObject
			, ControlWidth			buttonWidth
			, ControlId				r4id
			, ControlSelectState	Unable
			]
		) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
	:+: lbobj
	:+: CheckControl
		[ ("Show Full Names",Nothing,toMark inifull,showFullPaths)
		]
		(Columns 1)
		[ ControlPos (Left,zero)
		, ControlId c4id
		]

//--

807
808
809
810
811
812
813
814
815
816
817
showFullPaths (ls=:{ap,pp,tg,full,c1id,c2id,c3id,c4id,lbpadId,lbobjId,lblibId,lbsllId},ps)
	#	full= not full
		ps	= appPIO (setCheckControlMarks [c1id,c2id,c3id,c4id] full) ps
		ps	= closeAllExtListBoxItems lbpadId ps
		ps	= appendExtListBoxItems lbpadId (zip3 (StrictListToList(FullPaths full ap pp tg.target_path))(repeat id)(repeat id)) ps
		ps	= closeAllExtListBoxItems lbobjId ps
		ps	= appendExtListBoxItems lbobjId (zip3 (StrictListToList(FullPaths full ap pp tg.target_objs))(repeat id)(repeat id)) ps
		ps	= closeAllExtListBoxItems lblibId ps
		ps	= appendExtListBoxItems lblibId (zip3 (StrictListToList(FullPaths full ap pp tg.target_libs))(repeat id)(repeat id)) ps
		ps	= closeAllExtListBoxItems lbsllId ps
		ps	= appendExtListBoxItems lbsllId (zip3 (StrictListToList(FullPaths full ap pp tg.target_stat))(repeat id)(repeat id)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
818
819
	= ({ls & full = full},ps)

820
addLibrary (ls=:{tg,full,ap,pp,lblibId},ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
821
822
823
	#	(fs,ps)				= selectInputFile ps
	| isNothing fs = (ls,ps)
	#	pathname			= (fromJust fs)
824
825
		ls					= {ls & tg.target_libs = Append tg.target_libs pathname}
		ps					= appendExtListBoxItems lblibId (zip3[FullPath full ap pp pathname](repeat id)(repeat id)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
826
827
	= (ls,ps)

828
829
remLibrary (ls=:{tg,ap,pp,lblibId},ps)
	#	((ok,sel),ps)		= getExtListBoxSelection lblibId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
830
831
	| not ok || isEmpty sel = (ls,ps)
	#	(pathsel,indexsel)	= unzip sel
832
833
834
835
		ls					= {ls & tg.target_libs = RemoveMembers tg.target_libs
									(fulPaths ap pp (ListToStrictList pathsel))}
		ps					= closeExtListBoxItems lblibId indexsel ps
		ps					= setExtListBoxSelection lblibId [] ps
Diederik van Arkel's avatar
Diederik van Arkel committed
836
837
	= (ls,ps)

838
addStatic (ls=:{tg,full,ap,pp,lbsllId},ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
839
840
841
	#	(fs,ps)				= selectInputFile ps
	| isNothing fs = (ls,ps)
	#	pathname			= (fromJust fs)
842
843
		ls					= {ls & tg.target_stat = Append tg.target_stat pathname}
		ps					= appendExtListBoxItems lbsllId (zip3[FullPath full ap pp pathname](repeat id)(repeat id)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
844
845
	=  (ls,ps)

846
847
remStatic (ls=:{tg,ap,pp,lbsllId},ps)
	#	((ok,sel),ps)		= getExtListBoxSelection lbsllId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
848
849
	| not ok || isEmpty sel = (ls,ps)
	#	(pathsel,indexsel)	= unzip sel
850
851
852
853
		ls					= {ls & tg.target_stat = RemoveMembers tg.target_stat
									(fulPaths ap pp (ListToStrictList pathsel))}
		ps					= closeExtListBoxItems lbsllId indexsel ps
		ps					= setExtListBoxSelection lbsllId [] ps
Diederik van Arkel's avatar
Diederik van Arkel committed
854
855
	=  (ls,ps)
				
856
addObject (ls=:{tg,full,ap,pp,lbobjId},ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
857
858
859
	#	(fs,ps)				= selectInputFile ps
	| isNothing fs = (ls,ps)
	#	pathname			=  (fromJust fs)
860
861
		ls					= {ls & tg.target_objs = Append tg.target_objs pathname}
		ps					= appendExtListBoxItems lbobjId (zip3[FullPath full ap pp pathname](repeat id)(repeat id)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
862
863
	= (ls,ps)

864
865
remObject (ls=:{tg,ap,pp,lbobjId},ps)
	#	((ok,sel),ps)		= getExtListBoxSelection lbobjId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
866
867
	| not ok || isEmpty sel = (ls,ps)
	#	(pathsel,indexsel)	= unzip sel
868
869
870
871
		ls					= {ls & tg.target_objs = RemoveMembers tg.target_objs
									(fulPaths ap pp (ListToStrictList pathsel))}
		ps					= closeExtListBoxItems lbobjId indexsel ps
		ps					= setExtListBoxSelection lbobjId [] ps
Diederik van Arkel's avatar
Diederik van Arkel committed
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
	= (ls,ps)

//--

setCheckControlMarks ids full io
	= seq [setCheckControlMark full id \\ id <- ids] io
setCheckControlMark full id io
	= case full of
		True	-> markCheckControlItems id [1] io
		False	-> unmarkCheckControlItems id [1] io

//--

FullPath True _ _ p = p
FullPath False ap pp l = symPath ap pp l

FullPaths True _ _ l = l
FullPaths False ap pp l = symPaths ap pp l