targetui.icl 28.1 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 "Up"
							[ControlFunction (lbUp lbId)
							,ControlPos (BelowPrev,zero)
							]
						:+: ButtonControl "Dn"
							[ControlFunction (lbDn lbId)
							,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
		# datt			= [WindowId dId,WindowOk okId, WindowClose ( (okfun lbId dId (length targets)))]
Diederik van Arkel's avatar
Diederik van Arkel committed
155
156
157
		# (_,ps)		= openModalDialog targets (Dialog "Edit Environments List" ddef datt) ps
		= ps
	where
Diederik van Arkel's avatar
Diederik van Arkel committed
158
159
160
161
162
163
		lbUp lbId (ls,ps)
			# (_,(ls,ps)) = upSelItem lbId (ls,ps)
			= (ls,ps)
		lbDn lbId (ls,ps)
			# (_,(ls,ps)) = dnSelItem lbId (ls,ps)
			= (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
164
165
166
167
168
169
170
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
219
220
221
222
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
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
		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}
			# targets = insertAt (sel-1) target targets
			# ps	= openExtListBoxItems lbId sel [toItem target] ps
			= (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
			# ps			= closeWindow dId ps
			= (targets,ps)
	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
264
265
266
267
268
269
270
271
272
273
274
275
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
	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
		# (envpath,ps)		= selectOutputFile "" envpath ps
		| isNothing envpath	= (ls,ps)
		# envpath			= fromJust envpath
		# (ok,ps)			= saveEnvironments envspath [env] ps
		| not ok
			# ps			= okNotice ["Unable to save environment."] ps
			= (ls,ps)
		= (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
302
303
304
//--

newNameDialog ininame cont (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
305
	# (textId,ps)	= openId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
306
307
308
	# (editId,ps)	= openId ps
	# (windId,ps)	= openId ps
	# (okId,ps)		= openId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
309
310
311
	# (cancelId,ps)	= openId ps
	# (ts,ps)		= getTargets ps
	# names			= map (\{target_name}->target_name) ts
Diederik van Arkel's avatar
Diederik van Arkel committed
312
313
	# ((err,en),ps)	= openModalDialog Nothing
						(Dialog "Environment Name"
Diederik van Arkel's avatar
Diederik van Arkel committed
314
315
316
317
						(	TextControl "Enter name for environment"
							[ ControlId textId
							]
						:+:	EditControl ininame (PixelWidth 150) 1
318
							[ ControlId editId
Diederik van Arkel's avatar
Diederik van Arkel committed
319
							, ControlPos (Left,zero)
320
321
							, ControlActivate (noLS (appPIO (setEditControlSelection editId 1 0)))
							]
Diederik van Arkel's avatar
Diederik van Arkel committed
322
						:+: ButtonControl "OK"
Diederik van Arkel's avatar
Diederik van Arkel committed
323
							[ControlPos (Right,zero),ControlFunction (okfun textId editId windId names),ControlId okId]
Diederik van Arkel's avatar
Diederik van Arkel committed
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
						:+: 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
340
	okfun textId editId windId names (_,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
341
342
343
344
345
		# (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
346
347
348
349
350
		| 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
351
352
		= (maybename,closeWindow windId ps)
	cancelfun windId (_,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
353
//		#! ps = trace_n` ("cancel") ps
Diederik van Arkel's avatar
Diederik van Arkel committed
354
		= (Nothing,closeWindow windId ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
355
//import dodebug
Diederik van Arkel's avatar
Diederik van Arkel committed
356
357
358
359
360
361
362
363
364
365
366
367
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
//--

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
478
				(ddef wid okId cancelId lbobj lbobjId lblib lblibId (siz.Size.h) lbpadId lbsll
Diederik van Arkel's avatar
Diederik van Arkel committed
479
480
481
482
483
484
485
486
				 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
487
	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
488
489
490
491
492
493
494
495
		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
496
					:+: Pane "Paths" (pathpane ap pp tg.target_path inifull height lbpadId c1id r1id)
Diederik van Arkel's avatar
Diederik van Arkel committed
497
498
499
500
501
502
					:+: 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
503
	=	ButtonControl "Done"
Diederik van Arkel's avatar
Diederik van Arkel committed
504
505
506
507
		[ ControlFunction savefun
		, ControlId okId, ControlPos (Right,zero)
		, ControlWidth width
		]
Diederik van Arkel's avatar
Diederik van Arkel committed
508
/*	:+: ButtonControl "Save As..."
Diederik van Arkel's avatar
Diederik van Arkel committed
509
510
511
512
		[ ControlFunction saveasfun
		, ControlPos (LeftOfPrev,zero)
		, ControlWidth width
		]
Diederik van Arkel's avatar
Diederik van Arkel committed
513
*/	:+:	ButtonControl "Cancel"
Diederik van Arkel's avatar
Diederik van Arkel committed
514
515
516
517
518
519
520
521
		[ 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
522
	savefun (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
523
		# (ls,ps)	= commonsave (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
524
		# (tg,ls)	= ls!tg
525
526
		# ps		= setTs (updateAt ct tg ts) ps
		# ps		= setProjectTarget tg.target_name ps
Diederik van Arkel's avatar
Diederik van Arkel committed
527
528
		// possible since we know it's only possible to edit the active environment...
		= (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
529
	saveasfun (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
530
		# (ls,ps)	= commonsave (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
531
		# (tg,ls)	= ls!tg
532
		= newNameDialog tg.target_name contSaveAs (ls,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
533
534
	contSaveAs target_name (ls,ps)
		# ls		= {ls & tg.target_name = target_name}
535
536
		# (tg,ls)	= ls!tg
		# ps		= setTs (ts++[tg]) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
537
		# ((_,eTargetId),ps) = getTargetIds ps
538
		# (err,ps)		= accPIO (openRadioMenuItems eTargetId (1 + length ts) [targetToMenuEntry` tg]) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
539
540
541
542
543
544
545
546
547
548
549
550
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
		| 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]
586
587
588
589
	:+: 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
590
	:+: TextControl "Generator: " [ControlPos (Left,zero),ControlWidth textWidth]
591
592
593
594
	:+: 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
595
	:+: TextControl "Static Linker: " [ControlPos (Left,zero),ControlWidth textWidth]
596
597
598
599
	:+: 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
600
	:+: TextControl "Dynamic Linker: " [ControlPos (Left,zero),ControlWidth textWidth]
601
602
603
604
	:+: 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
605
	:+: TextControl "ABC version: " [ControlPos (Left,zero),ControlWidth textWidth]
606
607
608
609
	:+: 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
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
	:+: 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
629
630
		[ ControlId methId
		, case tg.target_meth of
Diederik van Arkel's avatar
Diederik van Arkel committed
631
632
			(CompileAsync _)	-> ControlSelectState Able
			_					-> ControlSelectState Unable
633
		, ControlActivate (noLS (appPIO (setEditControlSelection methId 1 0)))
Diederik van Arkel's avatar
Diederik van Arkel committed
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
		]
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
656
pathpane ap pp paths inifull height lbpadId c1id r1id
Diederik van Arkel's avatar
Diederik van Arkel committed
657
658
659
660
661
662
663
664
665
666
667
668
669
	=	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
670
671
		:+:	ButtonControl "Up" [ControlPos (Left,zero),ControlFunction lbUp]
		:+:	ButtonControl "Dn" [ControlPos (Left,zero),ControlFunction lbDn]
Diederik van Arkel's avatar
Diederik van Arkel committed
672
673
674
675
676
677
678
679
680
		) [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
681
682
683
684
685
686
687
688
689
690
691
692
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
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
720
721
722
723
724
725
726
727
728
729
730
731
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

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
		]

//--

795
796
797
798
799
800
801
802
803
804
805
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
806
807
	= ({ls & full = full},ps)

808
addLibrary (ls=:{tg,full,ap,pp,lblibId},ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
809
810
811
	#	(fs,ps)				= selectInputFile ps
	| isNothing fs = (ls,ps)
	#	pathname			= (fromJust fs)
812
813
		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
814
815
	= (ls,ps)

816
817
remLibrary (ls=:{tg,ap,pp,lblibId},ps)
	#	((ok,sel),ps)		= getExtListBoxSelection lblibId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
818
819
	| not ok || isEmpty sel = (ls,ps)
	#	(pathsel,indexsel)	= unzip sel
820
821
822
823
		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
824
825
	= (ls,ps)

826
addStatic (ls=:{tg,full,ap,pp,lbsllId},ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
827
828
829
	#	(fs,ps)				= selectInputFile ps
	| isNothing fs = (ls,ps)
	#	pathname			= (fromJust fs)
830
831
		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
832
833
	=  (ls,ps)

834
835
remStatic (ls=:{tg,ap,pp,lbsllId},ps)
	#	((ok,sel),ps)		= getExtListBoxSelection lbsllId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
836
837
	| not ok || isEmpty sel = (ls,ps)
	#	(pathsel,indexsel)	= unzip sel
838
839
840
841
		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
842
843
	=  (ls,ps)
				
844
addObject (ls=:{tg,full,ap,pp,lbobjId},ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
845
846
847
	#	(fs,ps)				= selectInputFile ps
	| isNothing fs = (ls,ps)
	#	pathname			=  (fromJust fs)
848
849
		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
850
851
	= (ls,ps)

852
853
remObject (ls=:{tg,ap,pp,lbobjId},ps)
	#	((ok,sel),ps)		= getExtListBoxSelection lbobjId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
854
855
	| not ok || isEmpty sel = (ls,ps)
	#	(pathsel,indexsel)	= unzip sel
856
857
858
859
		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
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
	= (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