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

import StdArray, StdFunc, StdMisc, StdTuple
import StdFileSelect,StdPStClass,StdWindow
import PmTypes, PmProject, PmPath, UtilStrictLists
import tabcontrol, ExtListBox, ioutil, IdeState
7
import ExtNotice, UtilObjectIO
8
import Platform, morecontrols
9
from projwin import pm_update_project_window
Diederik van Arkel's avatar
Diederik van Arkel committed
10 11 12 13 14 15 16

:: PO_LS =
	{ ao	:: !ApplicationOptions
	, cgo	:: !CodeGenOptions
	, paths	:: !List String
	, lo	:: !LinkOptions
	, xp	:: !String						// exepath
17
	, bytecodepath	:: !String
Diederik van Arkel's avatar
Diederik van Arkel committed
18
	, sl	:: !StaticLibInfo
19
	, post_link :: !Maybe String
Diederik van Arkel's avatar
Diederik van Arkel committed
20 21 22 23 24 25 26 27 28
	}

projectOptions :: !(PSt General) -> PSt General
projectOptions ps
	= projectDialog True ps

projectDefaults :: !(PSt General) -> PSt General
projectDefaults ps
	= projectDialog False ps
29

Diederik van Arkel's avatar
Diederik van Arkel committed
30 31 32 33 34 35 36 37 38 39 40 41 42 43
projectDialog :: !Bool !(PSt General) -> PSt General
projectDialog actualProject ps`
	# ((err,ret),ps)		= (if actualProject actualOpenOptionsDialog actualOpenDefaultsDialog) ps
	| NoError == err && isJust ret
		# ret				= fromJust ret
		// need to differentiate here between options and defaults...
		| actualProject
			// actualProject
			# prj			= PR_SetApplicationOptions ret.ao project
			# prj			= PR_SetCodeGenOptions ret.cgo prj
			# prj			= PR_SetLinkOptions prj ret.lo
			#(dp,ps)		= getCurrentPaths ps
			# prj			= PR_SetPaths False dp ret.paths prj
			# (appPath,ps)	= getStup ps
44
			# prjPath = PR_GetRootDir prj
Diederik van Arkel's avatar
Diederik van Arkel committed
45
			# prj			= PR_SetExecPath ret.xp prj
46
			# prj			= PR_SetByteCodePath ret.bytecodepath prj
Diederik van Arkel's avatar
Diederik van Arkel committed
47 48 49
			# prj			= PR_SetStaticLibsInfo ret.sl prj
			# (xxId,ps)		= getPWX ps
			# ps			= setFlexTexts [(xxId,ret.xp)] ps
50
			# prj			= PR_SetPostlink ret.post_link prj
Diederik van Arkel's avatar
Diederik van Arkel committed
51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
			= setProject prj ps
		// prefs
		# (prfs,ps)			= getPrefs ps
		# prfs				= {prfs & cgenopts = ret.cgo}
		# prfs				= {prfs & linkopts = ret.lo}
		# prfs				= {prfs & applopts = ret.ao}
		= setPrefs prfs ps
	= ps
where
	actualOpenOptionsDialog :: !(PSt General) ->  (!(!ErrorReport,!Maybe PO_LS),!PSt General)
	actualOpenOptionsDialog ps = openModalDialog inils
									(Dialog "Project Options"
									(panesOptions :+: buttons)
									[WindowClose cancelfun
									,WindowOk okId
									,WindowCancel cancelId
									,WindowId dlogId
									]) ps
	actualOpenDefaultsDialog :: !(PSt General) ->  (!(!ErrorReport,!Maybe PO_LS),!PSt General)
	actualOpenDefaultsDialog ps = openModalDialog inils
									(Dialog "Project Defaults"
									(panesDefaults :+: buttons)
									[WindowClose cancelfun
									,WindowOk okId
									,WindowCancel cancelId
									,WindowId dlogId
									]) ps
	// actualProject
	(project,ps0)	= getProject ps`
80 81
	([okId,cancelId,dlogId,hsId,ssId,emId,hmId,ihId,mhId,c1id,r1id,c2id,c3id,c4id,xpId,bytecodepathId,rsrcsId,symbolsId,post_link_id:_],ps1)
					= openIds 19 ps0
Diederik van Arkel's avatar
Diederik van Arkel committed
82 83 84 85 86
	(lbpadId,ps2)	= openExtListBoxId ps1
	(lbobjId,ps3)	= openExtListBoxId ps2
	(lbdlibId,ps4)	= openExtListBoxId ps3
	(lbslibId,ps5)	= openExtListBoxId ps4
	(ap,ps6)		= getStup ps5
87
	pp = PR_GetRootDir project
88
	(prefs,ps)		= PlatformDependant
89
						(getPrefs ps6)	// Win
90 91 92
						(getPrefs ps9)	// Mac
// mac only...
	(fontNames`, ps8)
93
					= accPIO (accScreenPicture getFontNames) ps6		// filteren naar alleen fixed width fonts....
94 95
//	(fixed,ps9)		= seqList (map (\f->accPIO (accScreenPicture (lisFixedWidth f))) fontNames`) ps8
	(fixed,ps9)		= accPIO (accScreenPicture (seqList (map lisFixedWidth fontNames`))) ps8
96

97 98 99 100 101 102 103 104 105 106 107
	fontNames		= lfilter fixed fontNames`
	fontSizes		= [7, 8, 9, 10, 12, 14, 18, 24 ]
	inifn			= ao.fn
	inifs			= ao.fs
	fontfun name (ls,ps)
		# ls		= {ls & ao.fn = name}
		= (ls,ps)
	sizefun size (ls,ps)
		# ls		= {ls & ao.fs = size}
		= (ls,ps)
// ...mac only
Diederik van Arkel's avatar
Diederik van Arkel committed
108 109 110 111 112
 	ao				= if actualProject (PR_GetApplicationOptions project) prefs.applopts
	cgo				= if actualProject (PR_GetCodeGenOptions project) prefs.cgenopts
	lo				= if actualProject (PR_GetLinkOptions project) prefs.linkopts
	paths			= PR_GetPaths project
	sl				= PR_GetStaticLibsInfo project 
113
	root_path		= PR_GetRootModuleDir project
114
	(post_link,_)	= PR_GetPostlink project
115
	inils			= {ao=ao,cgo=cgo,paths=paths,lo=lo,xp=fulexepath,bytecodepath=fulbcpath,sl=sl,post_link=post_link}
Diederik van Arkel's avatar
Diederik van Arkel committed
116 117 118 119
	
	// generic...
	panesOptions = TabControl
							(	applicationPane
120
							:+: compilerPane
Diederik van Arkel's avatar
Diederik van Arkel committed
121
							:+: diagnosticsPane
Diederik van Arkel's avatar
Diederik van Arkel committed
122
							:+: pathsPane ap pp paths False 200 lbpadId c1id r1id root_path
Diederik van Arkel's avatar
Diederik van Arkel committed
123 124 125 126
							:+: linkerPane
							:+: objectsPane
							:+: slibsPane
							:+: dlibsPane
127 128
							:+: bytecodePane
							) (Columns 3) [ControlPos (Left,zero)]
Diederik van Arkel's avatar
Diederik van Arkel committed
129 130
	panesDefaults = TabControl
							(	applicationPane
131
							:+: compilerPane
Diederik van Arkel's avatar
Diederik van Arkel committed
132 133
							:+: diagnosticsPane
							:+: linkerPane
134
							) (Columns 2) [ControlPos (Left,zero)]
Diederik van Arkel's avatar
Diederik van Arkel committed
135 136 137 138 139 140 141 142 143 144
	buttons
		=	ButtonControl "OK"
			[ControlFunction okfun,ControlPos (Right,zero), ControlId okId]
		:+: ButtonControl "Cancel"
			[ControlFunction cancelfun, ControlPos (LeftOfPrev,zero), ControlId cancelId]

	okfun (ls,ps)
		#	(wdef,ps)	= accPIO (getWindow dlogId) ps
		| isNothing wdef = abort "Fatal error in Project Options Dialog"
		#	wdef		= fromJust wdef
Diederik van Arkel's avatar
Diederik van Arkel committed
145 146
			[(ok1,hs),(ok2,ss),(ok3,hm),(ok4,ih),(ok5,mh):_]	= getControlTexts [hsId,ssId,hmId,ihId,mhId] wdef
		| not (ok1 && ok2 && ok3 && ok4 && ok5)
Diederik van Arkel's avatar
Diederik van Arkel committed
147
			= abort "More fatal stuff in Project Options dialog"
Diederik van Arkel's avatar
Diederik van Arkel committed
148
		| (isNothing hs) || (isNothing ss) || (isNothing hm) || (isNothing ih) || (isNothing mh)
Diederik van Arkel's avatar
Diederik van Arkel committed
149 150 151 152 153
			= abort "Yet more fatal stuff in Project Options dialog"
		# ls = { ls	& ao =
				{ls.ao
				& hs								= MemSizeToInt (fromJust hs)
				, ss								= MemSizeToInt (fromJust ss)
Diederik van Arkel's avatar
Diederik van Arkel committed
154
//				, em								= MemSizeToInt (fromJust em)
Diederik van Arkel's avatar
Diederik van Arkel committed
155 156 157 158
				, heap_size_multiple				= StringToFixedPoint (fromJust hm)
				, initial_heap_size					= MemSizeToInt (fromJust ih)
				, memoryProfilingMinimumHeapSize	= MemSizeToInt (fromJust mh)
				}}
Diederik van Arkel's avatar
Diederik van Arkel committed
159
		# ls = PlatformDependant ls (macstuff ls wdef)
Diederik van Arkel's avatar
Diederik van Arkel committed
160
		= (ls, closeWindow dlogId ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
161 162 163 164 165 166
	where
		macstuff ls wdef
			# (ok,em)= getControlText emId wdef
			| not ok || isNothing em = abort "Fatal mac specific"
			# ls = {ls & ao.em = MemSizeToInt (fromJust em)}
			= ls
Diederik van Arkel's avatar
Diederik van Arkel committed
167 168 169

	cancelfun (ls,ps) = (inils,closeWindow dlogId ps)

170 171 172 173
	fulexepath		= PR_GetExecPath project
	symexepath		= symPath ap pp fulexepath
	fulbcpath		= PR_GetByteCodePath project
	bytecodepath	= symPath ap pp fulbcpath
Diederik van Arkel's avatar
Diederik van Arkel committed
174 175

	setexe (ls,ps)
176
		# (prjPath,ps)	= getProjectFilePath ps
177
		# prjName		= RemoveSuffix (RemovePath prjPath)
178
		# prjPath = pp
Diederik van Arkel's avatar
Diederik van Arkel committed
179
		# (exename,ps)	= PlatformDependant
180
							(selectOutputFile` "Executable" "*.exe" "Set" ps)	// win
Diederik van Arkel's avatar
Diederik van Arkel committed
181 182 183 184 185 186 187 188 189 190
							(selectOutputFile "Executable" prjName ps)	// mac
		| isNothing exename
			= (ls,ps)
		# exename		= fromJust exename
		# (appPath,ps)	= getStup ps
		# exename		= symPath appPath prjPath exename
		# ls			= {ls & xp = exename}
		# ps			= appPIO (setControlText xpId ("Executable produced as: "+++exename)) ps
		= (ls,ps)

191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206
	setbytecodepath (ls,ps)
		# (prjPath,ps)	= getProjectFilePath ps
		# prjName		= RemoveSuffix (RemovePath prjPath)
		# prjPath = pp
		# (bcname,ps)	= PlatformDependant
							(selectOutputFile` "Bytecode" "*.bc" "Set" ps)	// win
							(selectOutputFile "Bytecode" prjName ps)	// mac
		| isNothing bcname
			= (ls,ps)
		# bcname		= fromJust bcname
		# (appPath,ps)	= getStup ps
		# bcname		= symPath appPath prjPath bcname
		# ls			= {ls & bytecodepath = bcname}
		# ps			= appPIO (setControlText bytecodepathId ("Bytecode produced as: "+++bcname)) ps
		= (ls,ps)

Diederik van Arkel's avatar
Diederik van Arkel committed
207 208 209
	applicationPane = Pane "Application"
		// heap size
		(	TextControl "Application Options" []
210 211 212 213 214
		:+:	EditControl (IntToMemSize ao.hs) (PixelWidth 100) 1
			[ ControlPos (Left,zero)
			, ControlId hsId
			, ControlActivate (noLS (appPIO (setEditControlSelection hsId 1 0)))
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
215 216
		:+: TextControl "Maximum Heap Size" []
		// stack size
217 218 219 220 221
		:+: EditControl (IntToMemSize ao.ss) (PixelWidth 100) 1
			[ ControlPos (Left,zero)
			, ControlId ssId
			, ControlActivate (noLS (appPIO (setEditControlSelection ssId 1 0)))
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
222
		:+: TextControl "Stack Size" []
Diederik van Arkel's avatar
Diederik van Arkel committed
223 224 225
		:+: PlatformDependant	// extra memory (want only on mac...)
			(NilLS)			// win
			(				// mac
226 227 228 229 230
				EditControl (IntToMemSize ao.em) (PixelWidth 100) 1
					[ ControlPos (Left,zero)
					, ControlId emId
					, ControlActivate (noLS (appPIO (setEditControlSelection emId 1 0)))
					]
Diederik van Arkel's avatar
Diederik van Arkel committed
231 232
			:+: TextControl "Extra Memory" []
			)
Diederik van Arkel's avatar
Diederik van Arkel committed
233
		// next heap size factor
234 235 236 237 238
		:+: EditControl (FixedPointToString ao.heap_size_multiple) (PixelWidth 100) 1
			[ ControlPos (Left,zero)
			, ControlId hmId
			, ControlActivate (noLS (appPIO (setEditControlSelection hmId 1 0)))
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
239 240
		:+: TextControl "Next Heap Size Factor" []
		// initial heap size
241 242 243 244 245
		:+: EditControl (IntToMemSize ao.initial_heap_size) (PixelWidth 100) 1
			[ ControlPos (Left,zero)
			, ControlId ihId
			, ControlActivate (noLS (appPIO (setEditControlSelection ihId 1 0)))
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
246 247 248
		:+: TextControl "Initial Heap Size" []
		// marking collector
		:+: CheckControl
Diederik van Arkel's avatar
Diederik van Arkel committed
249 250 251 252 253 254
			[	( "Enable dynamics"
				, Nothing
				, if (lo.method == LM_Static) NoMark Mark
				, noPS (\l->{l & lo = {l.lo & method = if (l.lo.method == LM_Static) LM_Dynamic LM_Static}})
				)
			,	( "Use Marking Garbage Collector"	
Diederik van Arkel's avatar
Diederik van Arkel committed
255 256 257 258
				, Nothing
				, toMark ao.marking_collection
				, noPS (\l->{l & ao = {l.ao & marking_collection = not l.ao.marking_collection}})
				)
259 260 261 262 263
			,	( "Disable RTS command line arguments"	
				, Nothing
				, toMark ao.disable_rts_flags
				, noPS (\l->{l & ao = {l.ao & disable_rts_flags = not l.ao.disable_rts_flags}})
				)				
Diederik van Arkel's avatar
Diederik van Arkel committed
264 265 266 267 268 269 270 271 272 273 274
			]
			(Columns 1)
			[ ControlPos (Left,zero)
			]
		// console type
		:+: TextControl "Console"
			[ ControlPos (Left,OffsetVector {zero & vy = 10})
			]
		:+: RadioControl
			[ ("Basic Values Only"	,Nothing,noPS (\l->{l & ao = {l.ao & o = BasicValuesOnly}}))
			, ("Show Constructors"	,Nothing,noPS (\l->{l & ao = {l.ao & o = ShowConstructors}}))
275
			, ("No Return Type"		,Nothing,noPS (\l->{l & ao = {l.ao & o = NoReturnType}}))
Diederik van Arkel's avatar
Diederik van Arkel committed
276 277 278 279 280 281
			, ("No Console"			,Nothing,noPS (\l->{l & ao = {l.ao & o = NoConsole}}))
			]
			(Columns 1)
			(case ao.o of
				BasicValuesOnly			-> 1
				ShowConstructors		-> 2
282 283
				NoReturnType			-> 3
				NoConsole				-> 4
Diederik van Arkel's avatar
Diederik van Arkel committed
284 285 286
			)
			[ ControlPos (Left,zero)
			]
287 288 289
		:+:	PlatformDependant
			NilLS
			(FontNameSizeControl inifn inifs fontNames fontSizes fontfun sizefun [])
Diederik van Arkel's avatar
Diederik van Arkel committed
290 291 292 293
		// .exe name and location
		:+: TextControl ("Executable produced as: "+++symexepath) [ControlId xpId,ControlPos (Left,zero):if actualProject [] [ControlHide]]
		:+: ButtonControl "Set executable..." [ControlFunction setexe,ControlPos (Left,zero):if actualProject [] [ControlHide]]
		)
294
	compilerPane = Pane "Compiler"
Diederik van Arkel's avatar
Diederik van Arkel committed
295 296 297 298 299 300 301
		(	TextControl "Profiling Options" []
		:+:	RadioControl
			[ ("Time Profile and Stack Trace",Nothing,noPS (\l->{l & ao = {l.ao & profiling = True, stack_traces = False}}))
			, ("Stack Trace only",Nothing,noPS (\l->{l & ao = {l.ao & profiling = True, stack_traces = True}}))
			, ("No Time Profiling",Nothing,noPS (\l->{l & ao = {l.ao & profiling = False, stack_traces = False}}))
			]
			(Columns 1)
302
			(if ao.profiling (if ao.stack_traces 2 1) 3)
Diederik van Arkel's avatar
Diederik van Arkel committed
303 304
			[ControlPos (Left,zero)]
		:+: CheckControl
305
			[("Heap Profile",Nothing,toMark ao.memoryProfiling, noPS (\l->{l & ao.memoryProfiling = not l.ao.memoryProfiling}))]
Diederik van Arkel's avatar
Diederik van Arkel committed
306
			(Columns 1) [ControlPos (Left,zero)]
307 308 309 310 311
		:+: EditControl (IntToMemSize ao.memoryProfilingMinimumHeapSize) (PixelWidth 100) 1
			[ ControlPos (Left,zero)
			, ControlId mhId
			, ControlActivate (noLS (appPIO (setEditControlSelection mhId 1 0)))
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
312
		:+: TextControl "Minimum Profile Heap" []
313 314 315 316 317
		:+:	TextControl "Language Options" [ControlPos (Left,OffsetVector {vx=0,vy=10})]
		:+: CheckControl
			[("Dynamics",Nothing,toMark ao.dynamics,noPS (\l->{l & ao.dynamics = not l.ao.dynamics}))]
			(Columns 1) [ControlPos (Left,zero)]
		:+:	TextControl "Code Generation Options" [ControlPos (Left,OffsetVector {vx=0,vy=10})]
318 319 320
		:+: CheckControl
			[("Generic Fusion",Nothing,toMark ao.generic_fusion,noPS (\l->{l & ao.generic_fusion = not l.ao.generic_fusion}))]
			(Columns 1) [ControlPos (Left,zero)]
321 322 323
		:+: CheckControl
			[("Generate descriptors and export labels",Nothing,toMark ao.desc_exl,noPS (\l->{l & ao.desc_exl = not l.ao.desc_exl}))]
			(Columns 1) [ControlPos (Left,zero)]
Diederik van Arkel's avatar
Diederik van Arkel committed
324 325 326 327 328 329 330 331 332 333 334 335
		)
	diagnosticsPane = Pane "Diagnostics"
		(	TextControl "Diagnostics Options" []
		:+:	CheckControl
			[ ("Show Execution Time"		,Nothing, toMark ao.set,noPS (\l->{l & ao = {l.ao & set = not l.ao.set}}))
			, ("Show Garbage Collections"	,Nothing, toMark ao.sgc,noPS (\l->{l & ao = {l.ao & sgc = not l.ao.sgc}}))
			, ("Print Stack Size"			,Nothing, toMark ao.pss,noPS (\l->{l & ao = {l.ao & pss = not l.ao.pss}}))
			, ("Write stderr to file"		,Nothing, toMark ao.write_stderr_to_file,noPS (\l->{l & ao = {l.ao & write_stderr_to_file = not l.ao.write_stderr_to_file}}))
			, ("Check Stacks"				,Nothing, toMark cgo.cs, noPS (\l->{l & cgo = {l.cgo &  cs = not l.cgo.cs}}))
			, ("Check Indices"				,Nothing, toMark cgo.ci, noPS (\l->{l & cgo = {l.cgo &  ci = not l.cgo.ci}}))
			]
			(Columns 1)
336 337
			[ControlPos (Left,zero)]
		:+: TextControl "Stack tracing can be set in the profiling panel." [ControlPos (Left,zero)]
Diederik van Arkel's avatar
Diederik van Arkel committed
338 339 340
		)
	linkerPane = Pane "Linker"
		(	TextControl "Linker Options" []
Diederik van Arkel's avatar
Diederik van Arkel committed
341
/*
Diederik van Arkel's avatar
Diederik van Arkel committed
342 343 344
		:+:	TextControl "Link Method" [ControlPos (Left,zero)]
		:+:	RadioControl
			[("Static"	,Nothing,noPS (\l->{l & lo = {l.lo & method = LM_Static}}))
Diederik van Arkel's avatar
Diederik van Arkel committed
345
//			,("Eager"	,Nothing,noPS (\l->{l & lo = {l.lo & method = LM_Eager}}))
Diederik van Arkel's avatar
Diederik van Arkel committed
346 347 348 349 350 351 352 353
			,("Lazy"	,Nothing,noPS (\l->{l & lo = {l.lo & method = LM_Dynamic}}))
			]
			(Rows 1) inilinkmethod
			[ ControlPos (Left,zero)
			]
		:+: TextControl "Link Options"				
			[ ControlPos (Left,OffsetVector {zero & vy = 10})
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
354
*/
Diederik van Arkel's avatar
Diederik van Arkel committed
355 356
		:+: CheckControl
			[ ("Generate Relocations"				,Nothing,toMark lo.generate_relocations,noPS (\ls -> {ls & lo = {ls.lo & generate_relocations = not ls.lo.generate_relocations}}))
357
			, ("Generate Symbol Table"				,Nothing,toMark lo.generate_symbol_table,noPS (\ls -> {ls & lo = {ls.lo & generate_symbol_table = not ls.lo.generate_symbol_table}}))
Diederik van Arkel's avatar
Diederik van Arkel committed
358
			, ("Generate Link Map"					,Nothing,toMark lo.generate_link_map,noPS (\ls -> {ls & lo = {ls.lo & generate_link_map = not ls.lo.generate_link_map}}))
359
			: PlatformDependant			
Diederik van Arkel's avatar
Diederik van Arkel committed
360
// winOnly
361
			[ ("Generate DLL"						,Nothing,toMark lo.generate_dll,noPS (\ls -> {ls & lo = {ls.lo & generate_dll = not ls.lo.generate_dll}}))
Diederik van Arkel's avatar
Diederik van Arkel committed
362 363
			, ("Use Standard Runtime Environment"	,Nothing,toMark ao.standard_rte,noPS (\l->{l & ao = {l.ao & standard_rte = not l.ao.standard_rte}}))
			, ("Include Resource Section"			,Nothing,toMark lo.link_resources,noPS (\ls->{ls & lo = {ls.lo & link_resources = not ls.lo.link_resources}}))
364 365
			]
// macOnly
366 367
//			[ ("Add 'carb' Resource"				,Nothing,toMark lo.add_carb_resource,noPS (\ls -> {ls & lo.add_carb_resource = not ls.lo.add_carb_resource}))
			[]
Diederik van Arkel's avatar
Diederik van Arkel committed
368 369 370
			] (Columns 1)
			[ ControlPos (Left,zero)
			]
371 372
		:+: PlatformDependant
// winOnly
Diederik van Arkel's avatar
Diederik van Arkel committed
373
		// .exe name and location
374
		(	TextControl ("Source of resource section: "+++lo.resource_source)
Diederik van Arkel's avatar
Diederik van Arkel committed
375 376 377 378 379 380 381 382
			[ControlId rsrcsId,ControlPos (Left,zero)]
		:+: ButtonControl "Set resource source..."
			[ControlFunction setrsrcs,ControlPos (Left,zero)]
		// .dll symbol source
		:+: TextControl ("Source of dll symbols: "+++lo.dll_export_list_name)
			[ControlId symbolsId,ControlPos (Left,zero)]
		:+: ButtonControl "Set dll symbol source..."
			[ControlFunction setsymbols,ControlPos (Left,zero)]
383 384 385 386
		:+: TextControl ("Postlink: "+++(case post_link of Just s -> s ; _ -> ""))
			[ControlId post_link_id,ControlPos (Left,zero)]
		:+: ButtonControl "Set postlink..."
			[ControlFunction set_post_link,ControlPos (Left,zero)]
Diederik van Arkel's avatar
Diederik van Arkel committed
387
		)
388 389
		NilLS
		)
390 391 392
	bytecodePane = Pane "Bytecode"
		(	TextControl "Bytecode options" []
		:+: CheckControl
393
			[("Generate bytecode",Nothing,toMark cgo.generate_bytecode,noPS (\l->{l & cgo.generate_bytecode = not l.cgo.generate_bytecode}))]
394 395 396 397 398 399 400 401 402 403
			(Columns 1) [ControlPos (Left,zero)]
		:+: CheckControl
			[("Use optimised ABC code",Nothing,toMark cgo.optimise_abc,noPS (\l->{l & cgo.optimise_abc = not l.cgo.optimise_abc}))]
			(Columns 1) [ControlPos (Left,zero)]
		:+: CheckControl
			[("Strip bytecode",Nothing,toMark lo.strip_bytecode,noPS (\l->{l & lo.strip_bytecode = not l.lo.strip_bytecode}))]
			(Columns 1) [ControlPos (Left,zero)]
		:+: TextControl ("Generate main bytecode file as: "+++bytecodepath) [ControlId bytecodepathId,ControlPos (Left,zero):if actualProject [] [ControlHide]]
		:+: ButtonControl "Set bytecode file..." [ControlFunction setbytecodepath,ControlPos (Left,zero):if actualProject [] [ControlHide]]
		)
404

Diederik van Arkel's avatar
Diederik van Arkel committed
405 406
	setrsrcs (ls,ps)
		# (rsrcname,ps)	= PlatformDependant
407
							(selectOutputFile` "Resource source" "*.exe" "Set" ps)	// win
Diederik van Arkel's avatar
Diederik van Arkel committed
408 409 410 411
							(selectOutputFile "Resource source" "" ps)		// mac
		| isNothing rsrcname
			= (ls,ps)
		# rsrcname		= fromJust rsrcname
412 413
		# (rsrcname,ps) = make_sym_path rsrcname ps
		# ls			= {ls & lo.resource_source = rsrcname}
Diederik van Arkel's avatar
Diederik van Arkel committed
414 415 416 417 418
		# ps			= appPIO (setControlText rsrcsId ("Source of resource section: "+++rsrcname)) ps
		= (ls,ps)

	setsymbols (ls,ps)
		# (symbname,ps)	= PlatformDependant
419
							(selectOutputFile` "DLL symbol source" "*" "Set" ps)	// win
Diederik van Arkel's avatar
Diederik van Arkel committed
420 421 422 423
							(selectOutputFile "DLL symbol source" "" ps)	// mac
		| isNothing symbname
			= (ls,ps)
		# symbname		= fromJust symbname
424 425
		# (symbname,ps)	= make_sym_path symbname ps
		# ls			= {ls & lo.dll_export_list_name = symbname}
Diederik van Arkel's avatar
Diederik van Arkel committed
426 427 428
		# ps			= appPIO (setControlText symbolsId ("Source of dll symbols: "+++symbname)) ps
		= (ls,ps)

429 430 431 432 433 434 435 436 437 438 439 440 441 442
	set_post_link (ls,ps)
		# (post_link,ps)	= PlatformDependant
							(selectInputFile` ps)	// win
							(selectInputFile  ps)	// mac
		| isNothing post_link
			= ({ls & post_link = Nothing},ps)
		# post_link		= fromJust post_link
		# (post_link,ps) = make_sym_path post_link ps
		# ls			= {ls & post_link = Just post_link}
		# ps			= appPIO (setControlText post_link_id ("Postlink: "+++post_link)) ps
		= (ls,ps)

	make_sym_path name ps
		# (appPath,ps)	= getStup ps
443
		  prjPath = pp
444 445
		= (symPath appPath prjPath name,ps)
		
Diederik van Arkel's avatar
Diederik van Arkel committed
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 490 491 492 493
	objectsPane = Pane "Extra Objects"
		{addLS = inifull
		,addDef
		=	TextControl "Object Paths" []
		:+: LayoutControl
			(	ButtonControl "Append..."
				[ ControlFunction addObject
				, ControlWidth buttonWidth
				]
			:+: ButtonControl "Remove"
				[ ControlPos (Left,zero)
				, ControlFunction remObject
				, ControlWidth buttonWidth
				]
			) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
		:+: lbobj
		:+: CheckControl
			[ ("Show Full Names",Nothing,toMark inifull,showFullPaths)
			]
			(Columns 1)
			[ ControlPos (Left,zero)
			, ControlId c2id
			]
		}
	where
		lbobj = ExtListBoxControl
	  				(zip3(FullPaths inifull ap pp (StrictListToList lo.extraObjectModules))(repeat id)(repeat id))
	  				[] // initial selection
	  				(\_ ps -> ps)
	  				lbobjId
	  				[ControlViewSize {h=200,w=300}]
		buttonWidth = ContentWidth "Append..."
		inifull = False
		addObject ((full,tg),ps)
			#	(fs,ps)				= selectInputFile ps
			| isNothing fs = ((full,tg),ps)
			#	pathname			=  (fromJust fs)
				tg					= {tg & lo = {tg.lo & extraObjectModules = Append tg.lo.extraObjectModules pathname}}
				ps					= appendExtListBoxItems lbobjId (zip3[FullPath full ap pp pathname](repeat id)(repeat id)) ps
			= ((full,tg),ps)
		remObject ((full,tg),ps)
			#	((ok,sel),ps)		= getExtListBoxSelection lbobjId ps
			| not ok || isEmpty sel = ((full,tg),ps)
			#	(pathsel,indexsel)	= unzip sel
				tg					= {tg & lo = {tg.lo & extraObjectModules = RemoveMembers tg.lo.extraObjectModules (ListToStrictList [fulPath ap pp s \\ s <- pathsel])}}
				ps					= closeExtListBoxItems lbobjId indexsel ps
				ps					= setExtListBoxSelection lbobjId [] ps
			= ((full,tg),ps)
494
		showFullPaths ((full,tg=:{lo}),ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
495 496 497
			#	full	= not full
				ps		= appPIO (setCheckControlMark full c2id) ps
				ps		= closeAllExtListBoxItems lbobjId ps
498
				ps		= appendExtListBoxItems lbobjId (zip3 (FullPaths full ap pp (StrictListToList lo.extraObjectModules))(repeat id)(repeat id)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546
			= ((full,tg),ps)
	slibsPane = Pane "Static Libraries"
		{addLS = inifull
		,addDef = TextControl "Static Libraries" []
		:+: LayoutControl
			(	ButtonControl "Append..."
				[ ControlFunction addSlib
				, ControlWidth buttonWidth
				]
			:+: ButtonControl "Remove"
				[ ControlPos (Left,zero)
				, ControlFunction remSlib
				, ControlWidth buttonWidth
				]
			) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
		:+: lbobj
		:+: CheckControl
			[ ("Show Full Names",Nothing,toMark inifull,showFullPaths)
			]
			(Columns 1)
			[ ControlPos (Left,zero)
			, ControlId c3id
			]
		}
	where
		lbobj = ExtListBoxControl
	  				(zip3(FullPaths inifull ap pp (StrictListToList (SL_Libs sl)))(repeat id)(repeat id))
	  				[] // initial selection
	  				(\_ ps -> ps)
	  				lbslibId
	  				[ControlViewSize {h=200,w=300}]
		buttonWidth = ContentWidth "Append..."
		inifull = False
		addSlib ((full,tg),ps)
			#	(fs,ps)				= selectInputFile ps
			| isNothing fs = ((full,tg),ps)
			#	pathname			=  (fromJust fs)
				tg					= {tg & sl = SL_Add pathname tg.sl}
				ps					= appendExtListBoxItems lbslibId (zip3[FullPath full ap pp pathname](repeat id)(repeat id)) ps
			= ((full,tg),ps)
		remSlib ((full,tg),ps)
			#	((ok,sel),ps)		= getExtListBoxSelection lbslibId ps
			| not ok || isEmpty sel = ((full,tg),ps)
			#	(pathsel,indexsel)	= unzip sel
				tg					= {tg & sl = SL_Rem pathsel ap pp sl}
				ps					= closeExtListBoxItems lbslibId indexsel ps
				ps					= setExtListBoxSelection lbslibId [] ps
			= ((full,tg),ps)
547
		showFullPaths ((full,tg=:{sl}),ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
548 549 550
			#	full	= not full
				ps		= appPIO (setCheckControlMark full c3id) ps
				ps		= closeAllExtListBoxItems lbslibId ps
551
				ps		= appendExtListBoxItems lbslibId (zip3 (FullPaths full ap pp (StrictListToList (SL_Libs sl)))(repeat id)(repeat id)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
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 598 599
			= ((full,tg),ps)
	dlibsPane = Pane "Dynamic Libraries"
		{addLS = inifull
		,addDef = TextControl "Dynamic Libraries" []
		:+: LayoutControl
			(	ButtonControl "Append..."
				[ ControlFunction addDlib
				, ControlWidth buttonWidth
				]
			:+: ButtonControl "Remove"
				[ ControlPos (Left,zero)
				, ControlFunction remDlib
				, ControlWidth buttonWidth
				]
			) [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
			]
		}
	where
		lbobj = ExtListBoxControl
	  				(zip3(FullPaths inifull ap pp (StrictListToList lo.libraries))(repeat id)(repeat id))
	  				[] // initial selection
	  				(\_ ps -> ps)
	  				lbdlibId
	  				[ControlViewSize {h=200,w=300}]
		buttonWidth = ContentWidth "Append..."
		inifull = False
		addDlib ((full,tg),ps)
			#	(fs,ps)				= selectInputFile ps
			| isNothing fs = ((full,tg),ps)
			#	pathname			=  (fromJust fs)
				tg					= {tg & lo = {tg.lo & libraries = Append tg.lo.libraries pathname}}
				ps					= appendExtListBoxItems lbdlibId (zip3[FullPath full ap pp pathname](repeat id)(repeat id)) ps
			= ((full,tg),ps)
		remDlib ((full,tg),ps)
			#	((ok,sel),ps)		= getExtListBoxSelection lbdlibId ps
			| not ok || isEmpty sel = ((full,tg),ps)
			#	(pathsel,indexsel)	= unzip sel
				tg					= {tg & lo = {tg.lo & libraries = RemoveMembers tg.lo.libraries (ListToStrictList [fulPath ap pp s \\ s <- pathsel])}}
				ps					= closeExtListBoxItems lbdlibId indexsel ps
				ps					= setExtListBoxSelection lbdlibId [] ps
			= ((full,tg),ps)
600
		showFullPaths ((full,tg=:{lo}),ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
601 602 603
			#	full	= not full
				ps		= appPIO (setCheckControlMark full c4id) ps
				ps		= closeAllExtListBoxItems lbdlibId ps
604
				ps		= appendExtListBoxItems lbdlibId (zip3 (FullPaths full ap pp (StrictListToList lo.libraries))(repeat id)(repeat id)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
605 606
			= ((full,tg),ps)

Diederik van Arkel's avatar
Diederik van Arkel committed
607
pathsPane ap pp paths inifull height lbpadId c1id r1id root_path
Diederik van Arkel's avatar
Diederik van Arkel committed
608 609 610 611 612 613 614 615 616 617 618 619
  = Pane "Project Paths"
	{addLS = inifull
	,addDef = TextControl "Project Paths" []
	:+: LayoutControl
		(	ButtonControl "Append..."
			[ ControlFunction addPath
			, ControlWidth buttonWidth
			]
		:+: ButtonControl "Remove"
			[ ControlPos (Left,zero)
			, ControlFunction removePath
			, ControlWidth buttonWidth
Diederik van Arkel's avatar
Diederik van Arkel committed
620 621
			, ControlId r1id
			, ControlSelectState Unable
Diederik van Arkel's avatar
Diederik van Arkel committed
622
			]
Diederik van Arkel's avatar
Diederik van Arkel committed
623 624
		:+:	ButtonControl "Up" [ControlPos (Left,zero),ControlFunction lbUp]
		:+:	ButtonControl "Dn" [ControlPos (Left,zero),ControlFunction lbDn]
Diederik van Arkel's avatar
Diederik van Arkel committed
625 626 627 628 629 630 631 632 633 634 635 636 637 638
		) [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
		]
	}
where
	lbpad = ExtListBoxControl
  				(zip3(FullPaths inifull ap pp (StrictListToList paths))(repeat id)(repeat id))
  				[] // initial selection
Diederik van Arkel's avatar
Diederik van Arkel committed
639 640 641 642
  				(\sel ps->case sel of
  					[]	-> appPIO (disableControl r1id) ps
  					_	-> appPIO (enableControl r1id) ps
  				)						// selection update function
Diederik van Arkel's avatar
Diederik van Arkel committed
643
  				lbpadId
Diederik van Arkel's avatar
Diederik van Arkel committed
644
  				[ControlViewSize {h=height,w=300}]
Diederik van Arkel's avatar
Diederik van Arkel committed
645
	buttonWidth = ContentWidth "Append..."
Diederik van Arkel's avatar
Diederik van Arkel committed
646 647 648 649 650 651 652 653 654 655 656 657
	lbUp ((full,tg),ps)
		# lo = tg.paths
		# (_,(lo,ps)) = upSelItem lbpadId (StrictListToList lo,ps)
		# lo = ListToStrictList lo
		# tg = {tg & paths = lo}
		= ((full,tg),ps)
	lbDn ((full,tg),ps)
		# lo = tg.paths
		# (_,(lo,ps)) = dnSelItem lbpadId (StrictListToList lo,ps)
		# lo = ListToStrictList lo
		# tg = {tg & paths = lo}
		= ((full,tg),ps)
658

Diederik van Arkel's avatar
Diederik van Arkel committed
659 660 661 662 663 664 665
	addPath ((full,tg),ps)
		#	(fs,ps)				= selectDirectory` ps
		| isNothing fs = ((full,tg),ps)
		#	pathname			= fromJust fs
			tg					= {tg & paths = Append tg.paths pathname}
			ps					= appendExtListBoxItems lbpadId (zip3 [FullPath full ap pp pathname](repeat id)(repeat id)) ps
		= ((full,tg),ps)
666

Diederik van Arkel's avatar
Diederik van Arkel committed
667 668 669 670 671 672 673 674 675 676 677 678 679
	removePath ((full,tg),ps)
		#	((ok,sel),ps)		= getExtListBoxSelection lbpadId ps
		| not ok || isEmpty sel
			= ((full,tg),ps)
		#	(pathsel,indexsel)	= unzip sel
			pathsel				= ListToStrictList [fulPath ap pp s \\ s <- pathsel]
		| StringOccurs root_path pathsel
			#! ps				= okNotice ["Removing path to main module not allowed."] ps
			= ((full,tg),ps)
		#	tg					= {tg & paths = RemoveMembers tg.paths pathsel}
			ps					= closeExtListBoxItems lbpadId indexsel ps
			ps					= setExtListBoxSelection lbpadId [] ps
		= ((full,tg),ps)
680
	showFullPaths ((full,tg=:{paths}),ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
681 682 683
		#	full	= not full
			ps		= appPIO (setCheckControlMark full c1id) ps
			ps		= closeAllExtListBoxItems lbpadId ps
684
			ps		= appendExtListBoxItems lbpadId (zip3 (FullPaths full ap pp (StrictListToList paths))(repeat id)(repeat id)) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
685 686 687 688 689 690 691
		= ((full,tg),ps)

setCheckControlMark full id io
	= case full of
		True	-> markCheckControlItems id [1] io
		False	-> unmarkCheckControlItems id [1] io

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 720 721 722 723
project_directory_up :: !(PSt General) -> PSt General
project_directory_up ps
	# (project,ps) = getProject ps
	| not (PR_ProjectSet project)
		= okNotice ["No open project"] ps
	# (project_file_path,ps) = getProjectFilePath ps
	  project_file_dir = RemoveFilename project_file_path
	  relative_root_dir = PR_GetRelativeRootDir project
	  parent_project_dir = make_project_dir (size relative_root_dir+1) project_file_dir
	| size parent_project_dir==0 || parent_project_dir==PR_GetRootDir project
		= okNotice ["Project directory cannot be moved further up"] ps
	# relative_root_dir = relative_root_dir+++"."
	  project = change_root_directory_of_project relative_root_dir parent_project_dir project
	  ps = setProject project ps
	= pm_update_project_window ps

project_directory_down :: !(PSt General) -> PSt General
project_directory_down ps
	# (project,ps) = getProject ps
	| not (PR_ProjectSet project)
		= okNotice ["No open project"] ps
	# (project_file_path,ps) = getProjectFilePath ps
	  project_file_dir = RemoveFilename project_file_path
	  relative_root_dir = PR_GetRelativeRootDir project
	  child_project_dir = make_project_dir (size relative_root_dir-1) project_file_dir
	| size relative_root_dir<=1 || child_project_dir==PR_GetRootDir project
		= okNotice ["Project directory cannot be moved further down"] ps	
	# relative_root_dir = relative_root_dir % (0,size relative_root_dir-2)
	  project = change_root_directory_of_project relative_root_dir child_project_dir project
	  ps = setProject project ps
	= pm_update_project_window ps

724
doPathsDialog :: !String !Pathname !Pathname !(List Pathname) ((List Pathname) (PSt .l) -> (PSt .l)) (PSt .l) -> (PSt .l)
Diederik van Arkel's avatar
Diederik van Arkel committed
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
doPathsDialog titlestring ap pp lo set ps
	#	(wid,ps)	= openId ps
		(okid,ps)	= openId ps
		(cancelid,ps)	= openId ps
		buttonwidth = ContentWidth "Append..."
		(siz,ps)	= controlSize (LayoutControl
						(	ButtonControl "Append..."
							[ ControlWidth buttonwidth
							]
						:+:	ButtonControl "Remove"
							[ ControlPos (Left,zero)
							, ControlWidth buttonwidth
							]
						:+:	ButtonControl "Up"
							[ ControlPos (Left,zero)
							, ControlWidth buttonwidth
							]
						:+:	ButtonControl "Dn"
							[ ControlPos (Left,zero)
							, ControlWidth buttonwidth
							]
						) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0])
						True
						Nothing Nothing Nothing ps
		(lb1Id,ps) = openExtListBoxId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
750
		(r1id,ps) = openId ps
Diederik van Arkel's avatar
Diederik van Arkel committed
751 752 753
		lbpad = ExtListBoxControl
	  				(zip3(FullPaths inifull ap pp (StrictListToList lo))(repeat id)(repeat id))
	  				[] // initial selection
Diederik van Arkel's avatar
Diederik van Arkel committed
754 755 756 757
	  				(\sel ps->case sel of
	  					[]	-> appPIO (disableControl r1id) ps
	  					_	-> appPIO (enableControl r1id) ps
	  				)						// selection update function
Diederik van Arkel's avatar
Diederik van Arkel committed
758 759
	  				lb1Id
	  				[ControlViewSize {h=siz.Size.h,w=300}]
Diederik van Arkel's avatar
Diederik van Arkel committed
760
		(_,ps) = openModalDialog (lo,inifull) (ddef wid okid cancelid lbpad lb1Id r1id siz) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
761 762 763
	= ps
where
	inifull = False
Diederik van Arkel's avatar
Diederik van Arkel committed
764
	ddef wid okId cancelId lb1 lb1Id r1id siz = Dialog "Paths"
Diederik van Arkel's avatar
Diederik van Arkel committed
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
			(title :+: left :+: buttons)
			[WindowId wid, WindowOk okId, WindowCancel cancelId, WindowClose cancel]
	where
		title
			=	TextControl titlestring [ControlPos (Center,zero)]
		buttons
			=	ButtonControl "Cancel" [ControlFunction cancel, ControlPos (Left,zero), ControlId cancelId]
			:+: ButtonControl "OK" [ControlFunction okfun, ControlId okId]
		cancel (ls,ps)
			# ps = closeWindow wid ps
			= (ls, ps)
		okfun ((lo,full),ps)
			#	ps = set lo ps
				ps = closeWindow wid ps
			= ((lo,full), ps)

		left = LayoutControl
				(TextControl "Paths" []
				:+: LayoutControl
					(	ButtonControl "Append..." 
						[ ControlFunction addPath
						]
					:+: ButtonControl "Remove"
						[ ControlPos (Left,zero)
						, ControlFunction removePath
Diederik van Arkel's avatar
Diederik van Arkel committed
790 791
						, ControlSelectState Unable
						, ControlId r1id
Diederik van Arkel's avatar
Diederik van Arkel committed
792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811
						]
						:+:	ButtonControl "Up" [ControlPos (Left,zero),ControlFunction lbUp]
						:+:	ButtonControl "Dn" [ControlPos (Left,zero),ControlFunction lbDn]
					) [ControlPos (Left,zero),ControlHMargin 0 0, ControlVMargin 0 0]
				:+: lb1
				:+: CheckControl
					[ ("Show Full Names",Nothing,toMark inifull,showFullPaths)
					]
					(Columns 1)
					[ ControlPos (Left,zero)
					]
				)
				[ControlPos (Left,zero)]
		where
			lbUp ((lo,full),ps)
				# (_,(lo,ps)) = upSelItem lb1Id (StrictListToList lo,ps)
				= ((ListToStrictList lo,full),ps)
			lbDn ((lo,full),ps)
				# (_,(lo,ps)) = dnSelItem lb1Id (StrictListToList lo,ps)
				= ((ListToStrictList lo,full),ps)
812

Diederik van Arkel's avatar
Diederik van Arkel committed
813 814 815 816 817 818 819
			addPath ((lo,full),ps)
				#	(fs,ps)				= selectDirectory` ps
				| isNothing fs = ((lo,full),ps)
				#	pathname			= fromJust fs
				#	lo					= Append lo pathname
				#	ps					= appendExtListBoxItems lb1Id (zip3 [FullPath full ap pp pathname](repeat id)(repeat id)) ps
				= ((lo,full),ps)
820

Diederik van Arkel's avatar
Diederik van Arkel committed
821 822 823 824 825 826 827 828 829 830 831 832 833 834
			removePath ((lo,full),ps)
				#	((ok,sel),ps)		= getExtListBoxSelection lb1Id ps
				| not ok || isEmpty sel = ((lo,full),ps)
				#	(pathsel,indexsel)	= unzip sel
					lo					= seq [RemoveStringFromList (fulPath ap pp s) \\ s <- pathsel] lo
					ps					= closeExtListBoxItems lb1Id indexsel ps
					ps					= setExtListBoxSelection lb1Id [] ps
				= ((lo,full),ps)
			showFullPaths ((lo,full),ps)
				#	full				= not full
					ps					= closeAllExtListBoxItems lb1Id ps
					ps					= appendExtListBoxItems lb1Id (zip3 (FullPaths full ap pp (StrictListToList lo))(repeat id)(repeat id)) ps
				= ((lo,full),ps)
		
835
doCompilerOptionsDialog :: !String !CompilerOptions (CompilerOptions (PSt .l) -> (PSt .l)) !(PSt .l) -> (PSt .l)
Diederik van Arkel's avatar
Diederik van Arkel committed
836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871
doCompilerOptionsDialog titlestring ini set ps
	# (wid,ps) = accPIO openId ps
	# (cid,ps) = accPIO openId ps
	# (okId,ps) = accPIO openId ps
	# (_,ps) = openModalDialog ini (ddef okId wid cid) ps
	= ps
where
	ddef okId wid cancelId = Dialog titlestring
			(title :+: left :+: right :+: buttons)
			[WindowId wid
			,WindowOk okId
			,WindowClose cancel
			,WindowCancel cancelId
			]
	where
		title = TextControl titlestring [ControlPos (Center,zero)]
		left = LayoutControl
				(TextControl "Program Analysis" []
				:+: CheckControl
					[ ("Strictness Analyzer",Nothing,toMark ini.sa,noPS (\l->{l & sa = not l.sa}))
					]
					(Columns 1)
					[ ControlPos (Left,zero)
					]
				:+: TextControl "Code Generation"
					[ ControlPos (Left,OffsetVector {zero & vy = 10})
					]
				:+: CheckControl
					[ ("Generate Comments",Nothing,toMark ini.gc,noPS (\l->{l & gc = not l.gc}))
					, ("Reuse Unique Nodes",Nothing,toMark ini.reuseUniqueNodes,noPS (\l->{l & reuseUniqueNodes = not l.reuseUniqueNodes}))
					, ("Never Time Profile",Nothing,toMark ini.neverTimeProfile,noPS (\l->{l & neverTimeProfile = not l.neverTimeProfile}))
//					, ("Never Memory Profile",Nothing,toMark ini.neverMemoryProfile,noPS (\l->{l & neverMemoryProfile = not l.neverMemoryProfile}))
					]
					(Columns 1)
					[ ControlPos (Left,zero)
					]
872 873 874 875 876 877 878 879 880 881 882 883 884 885
				:+: TextControl "Fusion" [ControlPos (Left,zero)]
				:+: RadioControl
					[ ("Default",Nothing,noPS (\l->{l & fusion = FusionDefault}))
					, ("Off",Nothing,noPS (\l->{l & fusion = FusionOff}))
					, ("On",Nothing,noPS (\l->{l & fusion = FusionOn}))
					]
					(Rows 1)
					(case ini.fusion of
						FusionDefault	-> 1
						FusionOff		-> 2
						FusionOn		-> 3
					)
					[ ControlPos (Left,zero)
					]
Diederik van Arkel's avatar
Diederik van Arkel committed
886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957
				)
				[ControlPos (Left,zero)]
		right = LayoutControl
				(TextControl "Diagnostics" []
				:+: CheckControl
					[ ("Give Warnings",Nothing,toMark ini.gw,noPS (\l->{l & gw = not l.gw}))
					, ("Be Verbose",Nothing,toMark ini.bv,noPS (\l->{l & bv = not l.bv}))
					]
					(Columns 1)
					[ ControlPos (Left,zero)
					]
				:+: TextControl "List Types"
					[ ControlPos (Left,OffsetVector {zero & vy = 10})
					]
				:+: RadioControl
					[ ("No Types",Nothing,noPS (\l->{l & listTypes = NoTypes}))
					, ("Inferred Types",Nothing,noPS (\l->{l & listTypes = InferredTypes}))
					, ("Strict Export Types",Nothing,noPS (\l->{l & listTypes = StrictExportTypes}))
					, ("All Types",Nothing,noPS (\l->{l & listTypes = AllTypes}))
					]
					(Columns 1)
					(case ini.listTypes of
						NoTypes				-> 1
						InferredTypes		-> 2
						StrictExportTypes	-> 3
						AllTypes			-> 4
					)
					[ ControlPos (Left,zero)
					]
				:+: CheckControl
					[ ("Show Attributes",Nothing,toMark ini.attr,noPS (\l->{l & attr = not l.attr}))
					]
					(Columns 1)
					[ControlPos (Left,zero)
					]
				)
				[]
		buttons
			=	ButtonControl "Cancel"
				[ ControlWidth (ContentWidth "Cancel")
				, ControlFunction cancel
				, ControlPos (Left,zero)
				, ControlId cancelId
				]
			:+: ButtonControl "OK"
				[ ControlWidth (ContentWidth "Cancel")
				, ControlFunction okfun
				, ControlId okId
				]
		cancel (ls,ps)
			# ps = closeWindow wid ps
			= (ls, ps)
		okfun (ls,ps)
			# ps = closeWindow wid ps
			  ps = set ls ps
			= (ls, ps)

//---

// Conversion from memory size to strings and back
    
Mega	:== 1048576;
Kilo	:== 1024;

IntToMemSize :: !Int -> String;
IntToMemSize mem
	| mega && mem <> 0
		=  megamemstr;
	| kilo && mem <> 0
		=  kilomemstr;
		=  memstr;
	where 
958 959
		mega		= mem rem Mega  == 0;
		kilo		= mem rem Kilo  == 0;
Diederik van Arkel's avatar
Diederik van Arkel committed
960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062
		megamemstr	= toString (mem / Mega)  +++ "M";
		kilomemstr	= toString (mem / Kilo)  +++ "K";
		memstr		= toString mem;
	

MemSizeToInt :: !String -> Int;
MemSizeToInt size =  scale * scaleless;
	where 
		scale		= GetScale size;
		scaleless	= StringToInt (RemoveScale size);
	
// Converts a string into a number

StringToInt	:: !String -> Int;
StringToInt string =  TextToNumber string 0;

TextToNumber :: !String !Int -> Int;
TextToNumber ""	n				=  n;
TextToNumber s	n	| isdigit	=  number;
								=  n;
	where 
	number		= TextToNumber (s % (1, dec (size s))) ( 10 * n  + d);
	(isdigit,d)	= Digit (s .[ 0]);
	

Digit :: !Char -> (!Bool, !Int);
Digit '0'  =  (True, 0); 	  Digit '1' =  (True, 1);
Digit '2'  =  (True, 2); 	  Digit '3' =  (True, 3);
Digit '4'  =  (True, 4); 	  Digit '5' =  (True, 5);
Digit '6'  =  (True, 6); 	  Digit '7' =  (True, 7);
Digit '8'  =  (True, 8);	  Digit '9' =  (True, 9);
Digit c	   =  (False,0);

	
GetScale :: !String -> Int;
GetScale num
	| lennum == 0
		=  0;
	| last == 'k' || last == 'K'
		=  Kilo;
	| last == 'm' || last == 'M'
		=  Mega;
		=  1;
	where 
		last	= num .[dec lennum];
		lennum	= size num;
	
		
RemoveScale	:: !String -> String;
RemoveScale num
	| lennum < 2
		=  num;
	| last == 'k' || last == 'K' || last == 'm'	|| last == 'M'
		=  num % (0, lennum - 2);
		= num;
	where 
		lennum	= size num;
		last	= num.[dec lennum];

StringToFixedPoint :: !String -> Int
StringToFixedPoint s
	| n<512+128
		= 512+128;
	| n>100<<8
		= 100<<8;
		= n;
where
		n=string_to_fixed_point 0 0 s;
		
		string_to_fixed_point i v s
			| i>= size s
				= v<<8;
			| char>='0' && char<='9'
				= string_to_fixed_point (inc i) (v*10+(toInt char-48)) s;
			| char=='.'
				= (v<<8)+fraction (inc i) s;
				= v<<8;
		where
				char=s.[i];
			
		fraction i s
			| i>= size s || char1<'0' || char1>'9'
				= 0;
			| inc i>= size s || char2<'0' || char2>'9'
				= ((toInt char1-48)<<8) / 10;
				= (((toInt char1-48)*10+(toInt char2-48))<<8)/100;
		where
			char1=s.[i];
			char2=s.[inc i];

FixedPointToString :: !.Int -> String
FixedPointToString n
	| n<512+128
		= "2.5";
	| n>100<<8
		= "100";
	| second_digit<>0
		= toString (n>>8)+++"."+++toString first_digit+++toString second_digit;
	| first_digit<>0
		= toString (n>>8)+++"."+++toString first_digit;
		= toString (n>>8);
where
		first_digit=fraction / 10;
1063
		second_digit=fraction rem 10;
Diederik van Arkel's avatar
Diederik van Arkel committed
1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075
		fraction=toInt (toReal (n bitand 255) * 100.0 / 256.0);

//-- path fiddling utils

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

FullPaths True _ _ l = l
FullPaths False ap pp l
	#	l = map (symPath ap pp) l
	#	l = map (symPath ap pp) l
	= l