implementation module EdFiles

//	File I/O routines for the editor.

import StdEnv
import deltaSystem, deltaFont
import UtilDiagnostics, UtilArray, UtilMayBe, _SystemArray, UtilSequence, UtilNewlinesFile

import EdDialogs, EdProgramState, EdMyIO, EdSupport, EdProject, EdPath, EdText, EdLists

NewlineChar	:== '\n'

CheckMixedNewlines :: !Pathname MixedNewlines !ProgState !IO -> (!ProgState, !IO);
CheckMixedNewlines path MixedNewlines prog io
	# (prog, io)
		=	AlertDialog ["Warning: mixed newline convention","file " +++ RemovePath path] prog io
	=	(prog, io);
CheckMixedNewlines _ _ prog io
	=	(prog, io);

// Determine the full pathname for a given module name

GetFullPathname	:: !Modulename !ProgState !Files -> ((!ProgState,!Pathname), !Files)
GetFullPathname modname prog=:{editor={editwindows,defaults={paths=defpaths},project}} files
	| windowpaths	=  ((prog, pathname1), files1)
	| diskpaths		=  ((prog, pathname2), files2)
					= ( (prog, EmptyPathname), files2)
where
	((diskpaths,pathname2),files2)	= SearchDisk False modname defpaths prjpaths files1
	((windowpaths,pathname1),files1)= SearchWindows windows modname Nil files
	windows							= GetUsedWindows editwindows
	prjpaths						= PR_GetPaths project
	
SearchWindows :: !(List EditWindow) !Modulename !(List Pathname) !*Files -> ((!Bool,!Pathname),!*Files)
SearchWindows Nil modname done disk =  ((False, EmptyPathname), disk)
SearchWindows (wd=:{wstate={pathname}}:!rest) modname done disk
	| skip		=  SearchWindows rest modname done disk
	| exists	=  ((True, dir_modname),disk1)
				=  SearchWindows rest modname done1 disk1	
where
	dir					= RemoveFilename pathname
	dir_modname			= MakeFullPathname dir modname
	done1				= dir :! done
	(exists,disk1)		= FExists dir_modname disk
	skip				= StringOccurs dir done || dir == EmptyPathname
	
//	Search for a ABC file

SearchABCFile :: !Modulename !(List Pathname) !*Files -> ((!Bool,!Pathname),!*Files);
SearchABCFile modname Nil disk
	= ((False,EmptyPathname), disk)
SearchABCFile modname (def:!rest) disk
	| exists	= ((True, abcpath), disk`)
				= SearchABCFile modname rest disk`
where
	(exists,disk`)	= FExists abcpath disk1
	(abcpath,disk1)	= MakeABCSystemPathname (MakeFullPathname def modname) disk

// Search disk for a file

SearchDisk :: !Bool !Modulename !(List Pathname) !(List Pathname) !*Files -> ((!Bool,!Pathname),!*Files)
SearchDisk def_and_imp modname defdirs prjdirs disk
	= SearchDisk2 def_and_imp modname modname2 prjdirs defdirs disk
where
	modname2	| not def_and_imp		= modname
				| IsDefPathname modname	= MakeImpPathname modname
										= MakeDefPathname modname

SearchDisk2 :: !Bool !Modulename !Modulename !(List Pathname) !(List Pathname) !*Files -> ((!Bool,!Pathname),!*Files)
SearchDisk2 def_and_imp modname1 modname2 Nil Nil disk
	=  ((False, EmptyPathname),disk)
SearchDisk2 def_and_imp modname1 modname2 Nil more_dirs disk
	= SearchDisk2 def_and_imp modname1 modname2 more_dirs Nil disk
SearchDisk2 def_and_imp modname1 modname2 (dir:!rest) more_dirs disk
	| existsa			= ((True, dir_modname1),diska)
	| not def_and_imp	= SearchDisk2 def_and_imp modname1 modname2 rest more_dirs diska
	| existsb			= ((True, dir_modname1),diskb)
						= SearchDisk2 def_and_imp modname1 modname2 rest more_dirs diskb
where
		dir_modname1	= MakeFullPathname dir modname1
		dir_modname2	= MakeFullPathname dir modname2
		(existsa,diska)	= FExists dir_modname1 disk
		(existsb,diskb)	= FExists dir_modname2 diska

//	Read a file

:: NewlinesCount
	=	{mac :: !Int, unix :: !Int, dos :: !Int}
:: MixedNewlines = MixedNewlines | NoMixedNewlines

AddNewline :: NewlineConvention NewlinesCount -> NewlinesCount
AddNewline NewlineConventionMac count
	=	{count & mac = count.mac + 1}
AddNewline NewlineConventionUnix count
	=	{count & unix = count.unix + 1}
AddNewline NewlineConventionDos count
	=	{count & dos = count.dos + 1}
AddNewline NewlineConventionNone count
	=	count

DetermineNewlineConvention :: NewlinesCount -> (MixedNewlines, NewlineConvention)
DetermineNewlineConvention count=:{mac, unix, dos}
	=	(if (max < total) MixedNewlines NoMixedNewlines, convention)
	where
		total
			=	mac + unix + dos
		(max, convention)
			=	if (mac > unix)
					(if (mac > dos)
						(mac, NewlineConventionMac)
						(dos, NewlineConventionDos))
					(if (unix > dos)
						(unix, NewlineConventionUnix)
						(dos, NewlineConventionDos))

ReadFile :: !Pathname !*Files -> ((!Bool, !Text, !NrLines, (!MixedNewlines, !NewlineConvention)),*Files)
ReadFile path disk
	| opened	=  ((closed, text, nrlines, DetermineNewlineConvention count),disk`)
				=  ((False, EmptyText, 1, (NoMixedNewlines, NewlineConventionNone)),disk1)
where
	(opened,file,disk1)	= fopen path FReadData disk
	(list,nrlines,count,file1) = ReadLinesFromFile  file
	text                 	= Text_StringsToText list
	(closed,disk`)			= fclose file1 disk1

ReadLinesFromFile :: !*File -> (!List String, !Int, !NewlinesCount, !*File)
ReadLinesFromFile file
	| eof	=  (last, nr, {mac=0, unix=0, dos=0},fil2)
			=  (ReplaceLastChar string :! rest, inc nrlines, (AddNewline convention count), newf)
where
	(eof,fil2)				= fend fil1
	(rest, nrlines, count, newf)	= ReadLinesFromFile  fil2
	(convention, string, fil1)	= readAnyLine file
	(last,nr)				= LastStrings string

LastStrings	:: !String -> (!List String, !Int)
LastStrings ""
	=  (NewlStr:!Nil, 1)
LastStrings str
	| NewlineChar==str.[dec (size str)]
		=  (str :! NewlStr :! Nil, 2)
		=  ((str +++ NewlStr) :! Nil, 1)

ReplaceLastChar	:: !String -> String
ReplaceLastChar str =  str := (dec (size str), NewlStr.[0])

// Save a file

SaveFile :: !Pathname !NewlineConvention !Text !*Files -> (!Bool, !*Files)
SaveFile path newlines text disk
	| opened 	=  (report, disk2)
				=  (False, disk1)
where
	(opened,file,disk1)	= fopen path FWriteText disk
	(_,file1)	= freopen file FWriteData
	(error,file2)		= ferror (WriteToFile text (toString newlines) file1)
	report				= opened &&  not error && closed
	(closed,disk2)		= fclose file2 disk1

WriteToFile	:: !Text {#Char} !*File -> *File
WriteToFile (block:!Nil) newlineString file =  WriteLastBlockToFile block newlineString file
WriteToFile (block:!blocks) newlineString file
	=  WriteToFile blocks newlineString (WriteBlockToFile block newlineString file)

WriteBlockToFile :: !Block !{#Char} !*File -> *File
WriteBlockToFile Nil _ file =  file
WriteBlockToFile (line:!lines) newlineString file
	=  WriteBlockToFile lines newlineString (writeAnyLine (ResetNewlineChar line) newlineString file)

WriteLastBlockToFile :: !Block {#Char} !*File -> *File
WriteLastBlockToFile (line:!Nil) newlineString file =  writeAnyLine laststr newlineString file
where
	laststr	= StripNewline 0 (ResetNewlineChar line)
WriteLastBlockToFile (line:!lines) newlineString file
	=  WriteLastBlockToFile lines newlineString (writeAnyLine (ResetNewlineChar line) newlineString file)

ResetNewlineChar :: !TLine -> String
ResetNewlineChar line = str := (dec (size str), NewlineChar) 
where
	str	= Line_LineToString line

StripNewline :: !Int !String -> String
StripNewline fro string | lmin1-fro < 0	=  ""
										=  string % (fro, dec lmin1)
where
	lmin1	= dec (size string)

//	Read the default settings

EqualPrefix :: String String -> Bool
EqualPrefix prefix string
	=	prefix == string % (0, size prefix - 1)

::	*Input	=	{ lineNumber :: !Int, lookAHead :: !String, file :: !*File}

EndOfInput :: *Input -> (!Bool, !*Input)
EndOfInput input=:{lookAHead}
	=	(lookAHead == "", input)

ReadStringOption :: String !String Input -> (!String, !Input)
ReadStringOption name defaultValue input=:{lookAHead}
	| EqualPrefix name lookAHead
		=	(ConvertToString lookAHead, NextLine input)
	| otherwise
		=	(defaultValue, input)	

ReadNumberOption :: String !Int Input -> (!Int, !Input)
ReadNumberOption name defaultValue input=:{lookAHead}
	| EqualPrefix name lookAHead
		=	(ConvertToNumber lookAHead, NextLine input)
	| otherwise
		=	(defaultValue, input)	

ReadBoolOption :: String !Bool Input -> (!Bool, !Input)
ReadBoolOption name defaultValue input=:{lookAHead}
	| EqualPrefix name lookAHead
		=	(ConvertToBoolean lookAHead, NextLine input)
	| otherwise
		=	(defaultValue, input)	

LabelMismatch :: {#Char} Int .a -> .a
LabelMismatch label line value
	=	Unexpected ("Label mismatch, expected " +++ label +++ " in line " +++ toString line +++ "\n")  value

ReadBoolean :: {#Char} Input -> (!Bool, !Input)
ReadBoolean label input=:{lineNumber, lookAHead}
	| EqualPrefix label lookAHead
		=	(ConvertToBoolean lookAHead, NextLine input)
	| otherwise
		=	LabelMismatch label lineNumber  (False, NextLine input)

ReadQuotedString :: {#Char} Input -> (!{#Char}, !Input)
ReadQuotedString label input=:{lineNumber, lookAHead}
	| EqualPrefix label lookAHead
		=	(UnquoteString lookAHead, NextLine input)
	| otherwise
		=	LabelMismatch label lineNumber  ("", NextLine input)

ReadNumber :: {#Char} Input -> (!Int, !Input)
ReadNumber label input=:{lineNumber, lookAHead}
	| EqualPrefix label lookAHead
		=	(ConvertToNumber lookAHead, NextLine input)
	| otherwise
		=	LabelMismatch label lineNumber  (0, NextLine input)

ReadString :: {#Char} Input -> (!{#Char}, !Input)
ReadString label input=:{lineNumber, lookAHead}
	| EqualPrefix label lookAHead
		=	(ConvertToString lookAHead, NextLine input)
	| otherwise
		=	LabelMismatch label lineNumber  ("", NextLine input)

LookAHead :: *File -> *Input
LookAHead file
	=	{ lineNumber = 1, lookAHead = nextLine, file = nextFile }
where
		(nextLine, nextFile)
			=	readLine file

NextLine :: *Input -> *Input
NextLine input=:{file, lineNumber}
	=	{ input & lineNumber = lineNumber+1, lookAHead = nextLine, file = nextFile}
where
		(nextLine, nextFile)
			=	readLine file

OldReadDefaultSettings	:: !Editor !*Files -> (!Editor, !*Files)
OldReadDefaultSettings editor disk
	| not opened
		= (editor,disk2)
		= (editor2,disk3)
where
	(startup,disk1)		= FStartUpDir ApplicationName disk
	(opened,file,disk2)	= fopen PrefsPath FReadData disk1

	(find,file1)		= OldReadFind (LookAHead file)
	(findid,file2)		= OldReadFindIdent file1
	(clip,file3)		= OldReadEditor file2
	(errors,file4)		= OldReadEditor file3
	(types,file5)		= OldReadEditor file4
	(project,file6)		= OldReadEditor file5
	(eo,file7)			= OldReadEditor file6
	(defaultCompilerOptions,file8)	= OldReadCompiler file7
	(cgo,file9)			= OldReadCodeGen file8
	(ao,file10)			= OldReadApplication file9
	(po,file11)			= OldReadProjectOpt file10 
	(paths,{file=file`})		= OldReadPathnames startup file11

	(_,disk3)			= fclose file` disk2
	editor2				= {editor & startupinfo.startupdir=startup,defaults=options,findinfo=find,findidinfo=findid}
	options				= {	defaultCompilerOptions=defaultCompilerOptions, cgo=cgo, ao=ao, po=po, paths=paths, linkOptions = DefaultLinkOptions,
								edit=eo, clip=clip, errors=errors, types=types, dproject=project }

OldReadFind :: !*Input -> (!FindInfo, !*Input)
OldReadFind file = (info, file`)
where
	info = {	find	= findstr,
				replace	= replacestr,
				ignore	= ignorestr,
				backw	= backwstr,
				wrapa	= wrapastr,
				matchw	= matchwstr }
	(matchwstr	, file`)	= ReadBoolean "Match Words" file5
	(wrapastr	, file5)	= ReadBoolean "Wrap Around" file4
	(backwstr	, file4)	= ReadBoolean "Backward" file3
	(ignorestr	, file3)	= ReadBoolean "Ignore" file2
	(replacestr	, file2)	= ReadQuotedString "Replace" file1
	(findstr	, file1)	= ReadQuotedString "Find" file

OldReadFindIdent :: !*Input -> (!FindIdentInfo, !*Input)
OldReadFindIdent file = (info, file`)
where
	info = {	search_kind = StringToSearchKind search_kind_s,
				cleanid	= cleanidstr,
				imp		= ConvertToSearchType impstr,
				export_	= exportstr,
				verbose	= verbosestr
			}
	(verbosestr	, file`)	= ReadBoolean "Be Verbose" file4
	(exportstr	, file4)	= ReadBoolean "Exported Ids Only" file3
	(impstr		, file3)	= ReadString "Search" file2
	(cleanidstr	, file2)	= ReadQuotedString "Clean Id" file1
	(search_kind_s,file1)	= ReadString "Find Kind" file

OldReadEditor :: !*Input -> (!EditWdOptions, !*Input)
OldReadEditor file =  (edit,file`)
where
	edit = {	eo			= {	DefaultEditOptions &
								tabs		= Between 1 99 tabsstr,
								fontname	= fontstr,
								fontsize	= Between MinFontSize MaxFontSize sizestr,
								autoi		= autostr},
				pos_size	= {	posx		= wposxstr,
								posy		= wposystr,
								sizex		= wsizexstr,
								sizey		= wsizeystr } }
	(wsizeystr	,file`)	= ReadNumber "Win size y" file7
	(wsizexstr	,file7)	= ReadNumber "Win size x" file6
	(wposystr	,file6)	= ReadNumber "Win pos y" file5
	(wposxstr	,file5)	= ReadNumber "Win pos x" file4
	(autostr	,file4)	= ReadBoolean "Auto indent" file3
	(tabsstr	,file3)	= ReadNumber "Tab stop every" file2
	(sizestr	,file2)	= ReadNumber "Font size" file1
	(fontstr	,file1)	= ReadString "Font" file

OldReadCompiler :: !*Input -> (!CompilerOptions, !*Input)
OldReadCompiler file =  (co,file`)
where
	co	= { neverMemoryProfile = not memoryProfile,
			neverTimeProfile	= not timeProfile,
			sa		= sastr,
			attr	= astr,
			listTypes
					= fromString tstr,
			gw		= gwstr,
			bv		= bvstr,
			gc		= gcstr,
			reuseUniqueNodes =  reuseUniqueNodes}

	(reuseUniqueNodes, file1)	= ReadBoolOption "Reuse Unique Nodes" defaults.reuseUniqueNodes file
	(memoryProfile, file2)	= ReadBoolOption "Module Memory Profile" (not defaults.neverMemoryProfile) file1
	(timeProfile, file3)	= ReadBoolean "" file2
	(sastr	, file4)	= ReadBoolean "Strictness Analyzer" file3
	(astr	, file5)	= ReadBoolean "Attributes" file4
	(tstr	, file6)	= ReadString "Types" file5
	(gwstr	, file7)	= ReadBoolean "Give Warnings" file6
	(bvstr	, file8)	= ReadBoolean "Be Verbose" file7
	(gcstr	, file`)	= ReadBoolean "Generate Comments" file8

	defaults = DefaultCompilerOptions

OldReadCodeGen	:: !*Input -> (!CodeGenOptions, !*Input)
OldReadCodeGen file =  (cgo, file`)
where
	cgo	= {	cs	= csstr,
			ci	= cistr,
			kaf	= kafstr,
			tp	= fromString tpstr }
	(csstr	, file1)	= ReadBoolean "Check Stacks" file
	(cistr	, file2)	= ReadBoolean "Check Indices" file1
	(kafstr	, file3)	= ReadBoolean "Keep ABC Files" file2
	(tpstr	, file`)	= ReadString "Target Processor" file3

OldReadApplication	:: !*Input -> (!ApplicationOptions, !*Input)
OldReadApplication file
		=  (ao,file17)
where
		ao	= {	hs	= hsstr,
				ss	= ssstr,
				em	= emstr,
				heap_size_multiple = heap_size_multiple_string,
				initial_heap_size = initial_heap_size_string ,
				set	= setstr,
				sgc	= sgcstr,
				pss	= pssstr,
				marking_collection = marking_collection_string,
				o	= ConvertToOutput ostr,
				fn	= fnstr,
				fs	= Between MinFontSize MaxFontSize fsstr,
				write_stderr_to_file
						= write_stderr_to_file,
				memoryProfiling = memoryProfiling,
				memoryProfilingMinimumHeapSize = memoryProfilingMinimumHeapSize,
				profiling = timeProfiling,
				profiling601 = timeProfiling601
			  }
		(hsstr,file1)	= ReadNumber "Heap Size" file
		(ssstr,file2)	= ReadNumber "Stack Size" file1
		(emstr,file3)	= ReadNumber "Extra Memory" file2
		(heap_size_multiple_string,file4) = ReadNumber "Next Heap Size Factor" file3
		(initial_heap_size_string,file5) = ReadNumber "Initial Heap Size" file4
		(setstr,file6)	= ReadBoolean "Show Execution Time" file5
		(sgcstr,file7)	= ReadBoolean "Show Garbage Collections" file6
		(pssstr,file8)	= ReadBoolean "Print Stack Size" file7
		(marking_collection_string,file9) = ReadBoolean "Marking Collection" file8
		(write_stderr_to_file, file10)	= ReadBoolOption "Write stderr" defaults.write_stderr_to_file file9
		(timeProfiling601, file11)	= ReadBoolOption "Profiling 601" defaults.profiling601 file10
		(timeProfiling, file12)	= ReadBoolOption "Profiling" defaults.profiling file11
		(memoryProfiling, file13)	= ReadBoolOption "Memory Profiling" defaults.memoryProfiling file12
		(memoryProfilingMinimumHeapSize, file14)
			= ReadNumberOption "Minimum Profiling Heap Size" defaults.memoryProfilingMinimumHeapSize file13

		defaults = DefApplicationOptions

		(ostr,file15) = ReadString "Output" file14
		(fnstr,file16)	= ReadString "Font" file15
		(fsstr,file17)	= ReadNumber "Font size" file16
	
OldReadProjectOpt	:: !*Input -> (!ProjectOptions, !*Input)
OldReadProjectOpt file
	= (po, file`)
where
		po	= {ProjectOptions | verbose = beverbosestr}
		(beverbosestr,file`)	= ReadBoolean "Be verbose"  file

OldReadPathnames :: !Pathname !*Input -> (!List String, !*Input)
OldReadPathnames application_directory_name file
	| eof
		= (Nil,file1)
	| NoPath pathstr
		= (Nil,file2)
	| otherwise
		= (path1:!paths,file3)
where
		(eof,file1)			= EndOfInput file
		(pathstr,file2)		= ReadString "Path" file1	
		(paths,file3)=OldReadPathnames application_directory_name file2
		path				= ConvertToPath pathstr
		path1				= replace_prefix_path "{Application}" application_directory_name path

OldDependencies :: !(List String) !*Input -> (!List String, !*Input)
OldDependencies paths file
	| eof	= (paths, file1)
	| eop	= (paths, file`)
			= OldDependencies (path:!paths) file`
where
	(eof,file1)			= EndOfInput file
	(pathstr,file`)		= ReadString "Dependency" file1
	eop					= NoPath pathstr
	path				= ConvertToPath pathstr

OldReadProjectPaths :: !Pathname !Pathname !*Input -> (!List String, !*Input)
OldReadProjectPaths project_directory_name application_directory_name file
	| eof
		= (Nil,file1)
	| NoPath pathstr
		= (Nil,file2)
	| otherwise
		= (path1:!paths,file3)
	where
		(paths,file3)=OldReadProjectPaths project_directory_name application_directory_name file2
		path1 = replace_prefix_path "{Application}" application_directory_name
				(replace_prefix_path "{Project}" project_directory_name (ConvertToPath pathstr))
		(eof,file1)			= EndOfInput file
		(pathstr,file2)		= ReadString "Path" file1

ConvertToNumber	:: !String -> Int
ConvertToNumber str
	=  SubStringToInt aftercolon strlen str
where
	strlen		= size str
	aftercolon	= FindColon 0 strlen str

ConvertToString	:: !String -> String
ConvertToString str = StripNewline (FindColon 0 (size str) str) str

ConvertToBoolean :: !String -> Bool
ConvertToBoolean str
	|  aftercolon >= lenstr	= False
							= first == 'y' || first == 'Y' 
where
	aftercolon	= FindColon 0 lenstr str
	first     	= str.[aftercolon]
	lenstr		= size str
	
SubStringToInt	:: !Int !Int !String -> Int
SubStringToInt fro to string =  StringToInt2 0 fro to string

StringToInt2 :: !Int !Int !Int !String -> Int
StringToInt2 acc fro to str
	| fro >= to		= acc
	| isDigit cur	= StringToInt2 acc` (inc fro) to str
					= acc
where
	acc`	= 10 * acc + (toInt cur) - (toInt '0')
	cur		= str.[fro]

UnquoteString :: !String -> String
UnquoteString str
	| pos1 < pos2 && pos2 < strlen
		= str % (inc pos1, dec pos2)
		= ""
where
	pos1	= FindQuote str strlen 0
	pos2	= FindQuote str strlen (inc pos1)
	strlen	= size str
	
FindQuote :: !String !Int !Int -> Int
FindQuote str strlen pos
	| pos >= strlen			= strlen
	| str.[pos] == '\"'		= pos
							= FindQuote str strlen (inc pos)
	
ConvertToOutput	:: !String -> Output
ConvertToOutput str	| str == "BasicValuesOnly"		= BasicValuesOnly
					| str == "ShowConstructors"	= ShowConstructors
													= NoConsole 

StringToSearchKind :: !String -> SearchKind
StringToSearchKind str
	| str=="Implementation"
		= Implementation
	| str=="Identifiers"
		= Identifier
//	| str=="Definition"
		= Definition
	
ConvertToSearchType :: !String -> SearchType
ConvertToSearchType str	| str == "SearchPaths"		= SearchPaths
						| str == "SearchImports"	= SearchImports
													= SearchImports
						
ConvertToPath :: !String -> String
ConvertToPath pathstr
	| semipos >= length
		= ""
		= pathstr % (colpos, dec semipos)
where
		semipos	= FindSemiColon colpos length pathstr
		colpos	= 0  // FindColon 0 length pathstr
		length	= size pathstr
	
ConvertToDate :: !String -> DATE
ConvertToDate str
	| colpos >= strlen	= NoDate
						= {	exists	= first == 'y' || first == 'Y',
							yy		= SubStringToInt yypos mmpos str,
							mm		= SubStringToInt mmpos ddpos str,
							dd		= SubStringToInt ddpos hpos str,
							h		= SubStringToInt hpos mpos str,
							m		= SubStringToInt mpos spos str,
							s		= SubStringToInt spos strlen str }
where
	yypos	= SkipSpaces (FindSpace colpos strlen str) strlen str
	mmpos	= SkipSpaces (FindSpace yypos strlen str) strlen str
	ddpos	= SkipSpaces (FindSpace mmpos strlen str) strlen str
	hpos	= SkipSpaces (FindSpace ddpos strlen str) strlen str
	mpos	= SkipSpaces (FindSpace hpos strlen str) strlen str
	spos	= SkipSpaces (FindSpace mpos strlen str) strlen str
	first	= str.[colpos]
	colpos	= 0 // FindColon 0 strlen str
	strlen	= size str
	
NoPath :: !String -> Bool
NoPath pathstr
	= semipos == aftercolon || semipos >= length
where
	length		= size pathstr
	semipos		= FindSemiColon aftercolon length pathstr
	aftercolon	= SkipSpaces 0 length pathstr // FindColon 0 length pathstr

FindSemiColon :: !Int !Int !String -> Int
FindSemiColon i len str	| i >= len			= i
						| str .[ i]  == ';'	= i
											= FindSemiColon (inc i) len str

FindColon :: !Int !Int !String -> Int
FindColon i len str
	| i >= len				= i
	|  str .[ i]  == ':' 	= SkipSpaces (inc i) len str
							= FindColon (inc i) len str
								
FindSpace :: !Int !Int !String -> Int
FindSpace i len str	| i>= len || str .[ i] == ' '	= i
													= FindSpace (inc i) len str

SkipSpaces	:: !Int !Int !String -> Int
SkipSpaces i len str | i >= len || str .[ i] <> ' '	= i
	                     							= SkipSpaces (inc i) len str
//	Read the project file

OldReadProjectFile	:: !Pathname !(List Pathname) !Pathname !*Files -> ((!Project, !Bool), !*Files)
OldReadProjectFile path defdirs application_directory_name disk
	| opened	= ((project,closed), disk`)
				= ((project,False), disk1)
where
	(opened,file,disk1)	= fopen path FReadData disk
	(project,{file=file`})	= OldReadProject path application_directory_name defdirs (LookAHead file)
	(closed,disk`)			= fclose file` disk1

OldReadProject	:: !Pathname !Pathname !(List Pathname) !*Input -> (!Project, !*Input)
OldReadProject project_file_name application_directory_name defdirs file
	=  (project`, file`)
where
		(project1,prjdirs,file1)= OldReadProjectHeader project_directory_name application_directory_name file defdirs
		(project`,file`)		= OldReadModules defdirs prjdirs project1 project_directory_name application_directory_name file1
		project_directory_name	= RemoveFilename project_file_name

OldReadProjectHeader :: !Pathname !Pathname !*Input !(List Pathname) -> (!Project,!List Pathname,!*Input)
OldReadProjectHeader project_directory_name application_directory_name file defdirs
	=  (project, prjpaths,file6)
where
		project		= PR_AddRootModule builtstr cgo ao po prjpaths linkOptions mn info
		linkOptions = DefaultLinkOptions
		(builtstr	, file1)	= ReadBoolean "Project Built" file
		(cgo		, file2)	= OldReadCodeGen file1
		(ao			, file3)	= OldReadApplication file2
		(po, file4)	= OldReadProjectOpt file3
		(prjpaths, file5)
					= OldReadProjectPaths project_directory_name application_directory_name file4
		(mn,info	, file6)	= OldReadModule file5 defdirs prjpaths project_directory_name application_directory_name

OldReadModules	:: !(List Pathname) !(List Pathname) !Project !Pathname !Pathname !*Input -> (!Project, !*Input)
OldReadModules defdirs prjdirs project project_directory_name application_directory_name file
	| eof	= (project, file2)
			= OldReadModules defdirs prjdirs project` project_directory_name application_directory_name file3
where
	file1			= skipEmptyLines file
	(eof,file2)		= EndOfInput file1
	(mn,info,file3)	= OldReadModule file2 defdirs prjdirs project_directory_name application_directory_name
	project`		= PR_AddModule mn info project
	skipEmptyLines file
		| file.lookAHead == "\n"
			=	skipEmptyLines (NextLine file)
		// otherwise
			=	file

OldReadModule	:: !*Input !(List Pathname) !(List Pathname) !Pathname !Pathname -> (!Modulename,!ModInfo,!*Input)
OldReadModule file defdirs prjdirs project_directory_name application_directory_name
	= (mn, info, file`)
where
	(mn			, file1)	= ReadString "Module" file
	(dirstr		, file2)	= ReadString "Dir" file1
	(defeo		, file3)	= OldReadEditor file2
	(impeo		, file4)	= OldReadEditor file3
	(compilerOptions, file5)	= OldReadCompiler file4
	(defopenstr	, file6)	= ReadBoolean "Def Window Open" file5
	(impopenstr	, file7)	= ReadBoolean "Imp Window Open" file6
	(datestr	, file8)	= ReadString "Modified" file7
	(deps		, file`)	= OldDependencies Nil file8
	info					= { ModInfo |
									dir		= newdir,
									compilerOptions		
											= compilerOptions,
									defeo	= defeo,
									impeo	= impeo,
									defopen	= defopenstr,
									impopen	= impopenstr,
									date	= date,
									deps	= deps,
									abcLinkInfo	= { linkObjFileNames=Nil, linkLibraryNames=Nil }
								}
	olddir = replace_prefix_path "{Application}" application_directory_name
			(replace_prefix_path "{Project}" project_directory_name dirstr)
	same_dir				= StringOccurs olddir defdirs || StringOccurs olddir prjdirs
	newdir | same_dir		= olddir
							= ""
	date | same_dir			= ConvertToDate datestr
							= NoDate

FWriteStrings :: ![String] !*File -> *File
FWriteStrings [str : rest] file =  FWriteStrings rest (fwrites str file)
FWriteStrings []           file =  fwritec '\n' file

BoolToAnswer :: !Bool  -> String
BoolToAnswer False =  "No"
BoolToAnswer true  =  "Yes"

// RWS +++ escape quotes
QuoteString :: !String -> String
QuoteString str = "\"" +++ str +++ "\""

IntToOutput	:: !Output -> String
IntToOutput BasicValuesOnly		=  "BasicValuesOnly"
IntToOutput ShowConstructors	=  "ShowConstructors"
IntToOutput NoConsole			=  "NoConsole"

SearchKindToString :: !SearchKind -> String
SearchKindToString Definition = "Definition"
SearchKindToString Implementation = "Implementation"
SearchKindToString Identifier = "Identifiers"

instance toString SearchType
where
	toString :: !SearchType -> {#Char}
	toString SearchPaths	= "SearchPaths"
	toString SearchImports	= "SearchImports"

DateToString :: !DATE -> String
DateToString {exists,yy,mm,dd,h,m,s}
	=	BoolToAnswer exists +++ " " +++
		toString yy +++ " " +++ toString mm +++ " " +++ toString dd +++ " " +++
		toString h +++ " " +++ toString m +++ " " +++ toString s
	
/* Add the home directory path to the prefs file */

PrefsPath :: String
PrefsPath = HomePath PrefsFile

:: Label = {label :: !{#Char}}
:: Value = {value :: !{#Char}}
:: LineNumber :== Int

:: Option = Option LineNumber Label (MayBe Value) [Option]

CommentChar
	:==	'#'
LabelSeparatorChar
	:==	':'
TabSize
	:== 4

copy a :== {e \\ e <-: a}
RemoveWhiteSpace :: {#Char} -> {#Char}
RemoveWhiteSpace string
	| firstFound >= stringSize
		=	string
	| otherwise
		=	shiftChars firstFound (firstFound+1) (copy string)
	where
		stringSize
			=	size string

		firstFound
			=	findChar 0
		findChar i
			|  i >= stringSize || string.[i] == ' ' || string.[i] == '\t'
				=	i
			| otherwise
				=	findChar (i+1)

		shiftChars :: !Int !Int *{#Char} -> {#Char}
		shiftChars toPos fromPos string
			| fromPos >= stringSize
				=	string % (0, toPos-1)
			#! char
				=	string.[fromPos]
			| char == ' ' || char == '\t'
				=	shiftChars fromPos (toPos+1) string
			| otherwise
				=	shiftChars (toPos+1) (fromPos+1) {string & [toPos] = char}

RemoveNewLine :: {#Char} -> {#Char}
RemoveNewLine string
	| string.[size string-1] == '\n'
		=	string % (0, size string-2)
	| otherwise
		=	string

// lfold op :== foldl (flip op)
lfold op r l
	:==	lfold r l
	where
		lfold r []		= r
		lfold r [a:x]	= lfold (op a r) x

WriteOptionsFile :: [Option] *File -> *File
WriteOptionsFile options file
	=	file
	:-	fwrites "Version:	1.3\n"
	:-	writeOptions 0 options
	where
//		writeOptions indentation options file
//			=	lfold (writeOption indentation) file options
		writeOptions _ [] file
			=	file
		writeOptions indentation [h : t] file
			=	writeOptions indentation t (writeOption indentation h file)

		writeOption :: Int Option !*File -> *File
		writeOption indentation (Option _ {label} value subOptions) file
			=	file // ->> {' ' \\ i <- [0..indentation-1]} +++ label +++ " (writeOption)\n"
			:-	fwrites {'\t' \\ i <- [0..indentation-1]}
			:-	fwrites label
			:-  writeValue value
			:-	fwritec '\n'
			:-	writeOptions (indentation+1) subOptions

		writeValue Nothing file
			=	file
		writeValue (Just {value}) file
			=	file
			:-	fwrites ":\t"
			:-	fwrites value

ReadOptionsFile :: *File -> ([Option], *File)
ReadOptionsFile file
	# (options, input)
		=	parseOptions 0 (LookAHead file)
	=	(options, input.file)
	where
		parseLabelAndOption :: !Int !Int !Int !{#Char} -> (Label, MayBe Value)
		parseLabelAndOption begin end size string
			| end >= size
				=	({label = RemoveWhiteSpace (string % (begin, end-1))}, Nothing)
			| string.[end] == LabelSeparatorChar
				=	({label = RemoveWhiteSpace (string % (begin, end-1))}, Just {value = skipSpaces (end+1)})
				with
					skipSpaces position
						| position >= size
							=	""
						| string.[position] == ' ' || string.[position] == '\t'
							=	skipSpaces (position+1)
						| otherwise
							=	string % (position, size-1)
			| otherwise
				=	parseLabelAndOption begin (end+1) size string	

		parseOption :: !Int !Int !Int !*Input -> (!Option, !*Input)
		parseOption indentation currentIndentation offset input=:{lookAHead, lineNumber}
			| currentIndentation > indentation
				# (subOptions, input)
					=	parseOptions currentIndentation input
				=	(Option lineNumber {label=""} Nothing subOptions, input)
			| otherwise
				# (label, value)
					=	parseLabelAndOption offset offset (size strippedLookAHead) strippedLookAHead
				  		with
				  			strippedLookAHead
							  	=	(RemoveNewLine lookAHead)
				# (subOptions, input)
					=	parseOptions (indentation+TabSize) (NextLine input)
				=	(Option lineNumber label value subOptions, input)

		parseOptions :: !Int !*Input -> ([Option], !*Input)
		parseOptions indentation input
			# (currentIndentation, offset, input)
				=	parseIndentation input
			# (eof, input)
				=	EndOfInput input
			| eof || currentIndentation < indentation
				=	([], input)
			# (option, input)
				=	parseOption indentation currentIndentation offset input
			# (options, input)
				=	parseOptions indentation input
			=	([option : options], input)

		indentation :: {# Char } ->  (!Int, !Int)
		indentation string
			=	indentation 0 0 string
			where
				stringSize
					=	size string - 1 

				indentation :: !Int !Int {# Char } ->  (!Int, !Int)
				indentation offset indent string
					| offset >= stringSize || string.[offset] == CommentChar
						=	(-1, offset)
					| string.[offset] == ' '
						=	indentation (offset+1) (indent+1) string
					| string.[offset] == '\t'
						=	indentation (offset+1) (indent + (TabSize - (indent rem TabSize))) string
					| otherwise
						=	(indent, offset)

		parseIndentation :: *Input -> (!Int, !Int, *Input)
		parseIndentation input=:{lookAHead}
			| lookAHead == ""
				=	(0, 0, input)
			# (indentation, offset)
				=	indentation lookAHead
			| indentation == (-1)
				=	parseIndentation (NextLine input)
			| otherwise
				=	(indentation, offset, input)

::	Version	= {version :: [Int]}

instance == Version
where
	(==) a b
		=	a.version == b.version

instance < Version
where
	(<) a b
		=	a.version < b.version

:: Conversions a =
	{
		toValue
			:: a -> (MayBe Value, [Option]),
		fromValue
			:: (MayBe Value) [Option] a -> a
	}

Simple :: Conversions a | toString, fromString a
Simple	=
	{
		toValue
			= \value -> ((Just {value = toString value}), []),
		fromValue
			= fromValue
	}
	where
		fromValue Nothing _ value
			=	value
		fromValue (Just {value}) subOptionsTable list
			=	fromString value


Group subOptionTable	=
	{
		toValue
			= \value -> (Nothing, PutOptions subOptionTable value),
		fromValue
			=	\_ subOptions value -> GetOptions subOptionTable subOptions value
	}

List optionsTableEntry defaultValue	=
	{
		toValue
			= \list -> (Nothing, putList list),
		fromValue
			= fromValue 
	}
	where
		putList Nil
			=	[]
		putList (h :! t)
			// =	PutOption h optionsTableEntry :!
			// otherwise
			=	case (PutOption h optionsTableEntry) of
					Nothing
						->	 putList t
					Just option
						->	[option : putList t]

		getList []
			=	Nil
		getList [h : t]
			=	GetOption {optionsTableEntry} h defaultValue :! getList t

		fromValue _ subOptionsTable list
			=	getList subOptionsTable

// +++ remove tables (too much code)
:: OptionsTableEntry a =
	E.value:
	{
		labelName
			:: !{#Char},
		conversions
			:: !Conversions value,
		get
			:: a -> value,
		put
			:: value a -> a
	}

:: OptionsTable a :== {!OptionsTableEntry a}

SimpleOption l g p :== {labelName = l, conversions = Simple, get = g, put = p}
GroupedOption  l s g p :== {labelName = l, conversions = Group s, get = g, put = p}
ListOption  l s d g p :== {labelName = l, conversions = List s d, get = g, put = p}

instance fromString Bool
where
	fromString "False"
		=	False
	fromString _ 
		=	True

instance fromString DATE
where
	fromString string
		=	ConvertToDate string
instance toString DATE
where
	toString date
		=	DateToString date

:: ModInfoAndName =
	{
		info	:: ModInfo,
		name	:: {#Char}
	}

ModInfoAndNameTable :: OptionsTable ModInfoAndName
ModInfoAndNameTable =
	{
		SimpleOption	"Name"									(\a->a.name)				(\v a->{a & name=v}),
		SimpleOption	"Dir"									(\a->a.info.dir)			(\v a->{a & info.dir=v}),
		SimpleOption	"IclOpen"								(\a->a.info.impopen)		(\v a->{a & info.impopen=v}),
		GroupedOption	"Compiler"		CompilerOptionsTable	(\a->a.info.compilerOptions)(\v a->{a & info.compilerOptions=v}),
		GroupedOption	"Dcl"			EditWdOptionsTable		(\a->a.info.defeo)			(\v a->{a & info.defeo=v}),
		SimpleOption	"DclOpen"								(\a->a.info.defopen)		(\v a->{a & info.defopen=v}),
		GroupedOption	"Icl"			EditWdOptionsTable		(\a->a.info.impeo)			(\v a->{a & info.impeo=v}),
		SimpleOption	"IclOpen"								(\a->a.info.impopen)		(\v a->{a & info.impopen=v}),
		SimpleOption	"LastModified"							(\a->a.info.date)			(\v a->{a & info.date=v}),
		ListOption		"Dependencies"	ModuleName ""			(\a->a.info.deps)			(\v a->{a & info.deps=v}),
// MW..
		ListOption		"NeededObjFiles" ObjectFile ""			(\a->a.info.abcLinkInfo.linkObjFileNames)
																(\v a->{a & info.abcLinkInfo.linkObjFileNames=v}),
		ListOption		"NeededLibraries" Library   ""			(\a->a.info.abcLinkInfo.linkLibraryNames)
																(\v a->{a & info.abcLinkInfo.linkLibraryNames=v}) 
// ..MW
	}

ModInfoAndNameEntry =
		GroupedOption "Module" ModInfoAndNameTable id const

:: ProjectGlobalOptions
	=	{
			built
				:: !Bool,
			codegen
				:: CodeGenOptions,
			application
				:: ApplicationOptions,
			projectOptions
				:: ProjectOptions,
			link
				:: LinkOptions,
			projectPaths
				:: List Pathname,
			otherModules
				:: List ModInfoAndName,
			mainModuleInfo
				:: ModInfoAndName
		}

GetProject :: {#Char} {#Char} Project -> ProjectGlobalOptions
GetProject applicationDir projectDir project
	=	{built=PR_Built project, codegen=PR_GetCodeGenOptions project,
			application=PR_GetApplicationOptions project, projectOptions=PR_GetProjectOptions project,
			projectPaths=projectPaths, link=linkOptions,
			mainModuleInfo=mainModuleInfo, otherModules=otherModules}
	where
		mainModuleInfo
			=	getModule mainModuleName
		mainModuleName
			=	PR_GetRootModuleName project

		otherModuleNames
			=	Filter ((<>) mainModuleName) (PR_GetModulenames False IclMod project)
		otherModules
			=	Map getModule otherModuleNames

		getModule name
			=	{name=name, info=substituteDirs (snd (PR_GetModuleInfo name project))}
			where
				substituteDirs :: ModInfo -> ModInfo
				substituteDirs info
					=	{info & dir = replace_prefix_path applicationDir "{Application}" (replace_prefix_path projectDir "{Project}" info.dir)}

		linkOptions
			=	SubstituteLinkOptionsPaths applicationDir projectDir (PR_GetLinkOptions project)
		projectPaths
			=	SubstitutePaths applicationDir projectDir  (PR_GetPaths project)

ExpandLinkOptionsPaths :: {#Char} {#Char} LinkOptions -> LinkOptions
ExpandLinkOptionsPaths applicationDir projectDir linkOptions=:{extraObjectModules, libraries}
	=	{linkOptions & extraObjectModules = ExpandPaths applicationDir projectDir extraObjectModules,
			 libraries = ExpandPaths applicationDir projectDir libraries}

ExpandPaths :: {#Char} {#Char} (List {#Char}) -> List {#Char}
ExpandPaths applicationDir projectDir list
	=	Map (replace_prefix_path "{Application}" applicationDir o replace_prefix_path "{Project}" projectDir) list

SubstituteLinkOptionsPaths :: {#Char} {#Char} LinkOptions -> LinkOptions
SubstituteLinkOptionsPaths applicationDir projectDir linkOptions=:{extraObjectModules, libraries}
	=	{linkOptions & extraObjectModules = SubstitutePaths applicationDir projectDir extraObjectModules,
			 libraries = SubstitutePaths applicationDir projectDir libraries}

SubstitutePaths :: {#Char} {#Char} (List {#Char}) -> List {#Char}
SubstitutePaths applicationDir projectDir list
	=	Map (replace_prefix_path applicationDir "{Application}" o replace_prefix_path projectDir "{Project}") list

SetProject :: {#Char} {#Char} ProjectGlobalOptions -> Project
SetProject applicationDir projectDir {built, codegen, application, projectOptions, projectPaths, link, mainModuleInfo={name, info},otherModules}
	=	PR_AddRootModule built codegen application projectOptions paths linkOptions name (expandDirs info)
	:-	addModules otherModules
	where
		paths
			=	ExpandPaths applicationDir projectDir  projectPaths
		linkOptions
			=	ExpandLinkOptionsPaths applicationDir projectDir link

		addModules Nil project
			=	project
		addModules ({name, info} :! t) project
			=	addModules t (PR_AddModule name (expandDirs info) project)

		expandDirs :: ModInfo -> ModInfo
		expandDirs info
			=	{info & dir = replace_prefix_path "{Application}" applicationDir (replace_prefix_path "{Project}" projectDir info.dir)}

ProjectGlobalOptionsTable :: OptionsTable ProjectGlobalOptions
ProjectGlobalOptionsTable =
	{
		SimpleOption	"Built"									(\a->a.built)			(\v a->{a & built=v}),
		GroupedOption	"CodeGen"		CodeGenOptionsTable		(\a->a.codegen)			(\v a->{a & codegen=v}),
		GroupedOption	"Application"	ApplicationOptionsTable	(\a->a.application)		(\v a->{a & application=v}),
		GroupedOption	"Project"		ProjectOptionsTable		(\a->a.projectOptions)	(\v a->{a & projectOptions=v}),
		GroupedOption	"Link"			LinkOptionsTable		(\a->a.link)			(\v a->{a & link=v}),
		ListOption		"Paths"			PathName ""				(\a->a.projectPaths)	(\v a->{a & projectPaths=v})
	}

ProjectTable :: OptionsTable ProjectGlobalOptions
ProjectTable =
	{
		// +++ order is important here
		GroupedOption	"Global" ProjectGlobalOptionsTable	id const,
		GroupedOption	"MainModule"	ModInfoAndNameTable		(\a->a.mainModuleInfo)	(\v a->{a & mainModuleInfo=v}),
		ListOption		"OtherModules"	ModInfoAndNameEntry {info=DummyModInfo,name=""}	(\a->a.otherModules)	(\v a->{a & otherModules=v})
	}

DefaultOptionsTable :: OptionsTable Defaults
DefaultOptionsTable =
	{
		GroupedOption	"DefCompiler"		CompilerOptionsTable	(\a->a.defaultCompilerOptions)	(\v a->{a & defaultCompilerOptions=v}),
		GroupedOption	"DefCodeGen"		CodeGenOptionsTable		(\a->a.cgo)						(\v a->{a & cgo=v}),
		GroupedOption	"DefApplication"	ApplicationOptionsTable	(\a->a.ao)						(\v a->{a & ao=v}),
		GroupedOption	"DefProject"		ProjectOptionsTable		(\a->a.po)						(\v a->{a & po=v}),
		ListOption		"DefPaths"			PathName ""				(\a->a.paths)					(\v a->{a & paths=v}),
//		GroupedOption	"DefLink"			LinkOptionsTable		(\a->a.linkOptions)				(\v a->{a & linkOptions=v}),
		GroupedOption	"Clipboard"			EditWdOptionsTable		(\a->a.clip)					(\v a->{a & clip=v}),
		GroupedOption	"DefEdit"			EditWdOptionsTable		(\a->a.edit)					(\v a->{a & edit=v}),
		GroupedOption	"Errors"			EditWdOptionsTable		(\a->a.errors)					(\v a->{a & errors=v}),
		GroupedOption	"Types"				EditWdOptionsTable		(\a->a.Defaults.types)			(\v a->{Defaults | a & types=v}),
		GroupedOption	"Project"			EditWdOptionsTable		(\a->a.dproject)				(\v a->{a & dproject=v})
	}

CompilerOptionsTable :: OptionsTable CompilerOptions
CompilerOptionsTable =
	{
		SimpleOption "NeverMemoryProfile"	(\a->a.neverMemoryProfile)	(\v a->{a & neverMemoryProfile=v}),
		SimpleOption "NeverTimeProfile"		(\a->a.neverTimeProfile)	(\v a->{a & neverTimeProfile=v}),
		SimpleOption "StrictnessAnalysis"	(\a->a.sa)					(\v a->{a & sa=v}),
		SimpleOption "ListTypes"			(\a->a.listTypes)			(\v a->{a & listTypes=v}),
		SimpleOption "ListAttributes"		(\a->a.attr)				(\v a->{a & attr=v}),
		SimpleOption "Warnings"				(\a->a.gw)					(\v a->{a & gw=v}),
		SimpleOption "Verbose"				(\a->a.bv)					(\v a->{a & bv=v}),
		SimpleOption "ReadableABC"			(\a->a.gc)					(\v a->{a & gc=v}),
		SimpleOption "ReuseUniqueNodes"		(\a->a.reuseUniqueNodes)	(\v a->{a & reuseUniqueNodes=v})
	}

CodeGenOptionsTable :: OptionsTable CodeGenOptions
CodeGenOptionsTable	=
	{
		SimpleOption "CheckStacks"		(\a->a.cs)		(\v a->{a & cs=v}),
		SimpleOption "CheckIndexes" 	(\a->a.ci)		(\v a->{a & ci=v}),
		SimpleOption "KeepABC" 			(\a->a.kaf)		(\v a->{a & kaf=v}),
		SimpleOption "TargetProcessor"	(\a->a.tp)		(\v a->{a & tp=v})
	}

instance fromString Int
where
	fromString s
		=	toInt s

ApplicationProfiletOptionsTable :: OptionsTable ApplicationOptions
ApplicationProfiletOptionsTable	=
	{
		SimpleOption "Memory"					(\a->a.memoryProfiling)					(\v a->{a & memoryProfiling=v}),
		SimpleOption "MemoryMinimumHeapSize"	(\a->a.memoryProfilingMinimumHeapSize)	(\v a->{a & memoryProfilingMinimumHeapSize=v}),
		SimpleOption "Time601"					(\a->a.profiling601)					(\v a->{a & profiling601=v}),
		SimpleOption "Time"						(\a->a.profiling)						(\v a->{a & profiling=v})
	}

ApplicationOutputOptionsTable :: OptionsTable ApplicationOptions
ApplicationOutputOptionsTable	=
	{
		SimpleOption "Output"		(\a->a.o)						(\v a->{a & o=v}),
		SimpleOption "Font"			(\a->a.fn)						(\v a->{a & fn=v}),
		SimpleOption "FontSize"		(\a->a.fs)						(\v a->{a & fs=v}),
		SimpleOption "WriteStdErr"	(\a->a.write_stderr_to_file)	(\v a->{a & write_stderr_to_file=v})
	}

ApplicationOptionsTable :: OptionsTable ApplicationOptions
ApplicationOptionsTable	=
	{
		SimpleOption "HeapSize"						(\a->a.hs)					(\v a->{a & hs=v}),
		SimpleOption "StackSize"					(\a->a.ss)					(\v a->{a & ss=v}),
		SimpleOption "ExtraMemory"					(\a->a.em)					(\v a->{a & em=v}),
		SimpleOption "IntialHeapSize"				(\a->a.initial_heap_size)	(\v a->{a & initial_heap_size=v}),
		SimpleOption "HeapSizeMultiplier"			(\a->a.heap_size_multiple)	(\v a->{a & heap_size_multiple=v}),
		SimpleOption "ShowExecutionTime"			(\a->a.set)					(\v a->{a & set=v}),
		SimpleOption "ShowGC"						(\a->a.sgc)					(\v a->{a & sgc=v}),
		SimpleOption "ShowStackSize"				(\a->a.pss)					(\v a->{a & pss=v}),
		SimpleOption "MarkingCollector"				(\a->a.marking_collection)	(\v a->{a & marking_collection=v}),
		GroupedOption "Profile"	ApplicationProfiletOptionsTable	id				const,
		GroupedOption "Output"	ApplicationOutputOptionsTable	id				const
	}

ProjectOptionsTable :: OptionsTable ProjectOptions
ProjectOptionsTable =
	{
		SimpleOption "Verbose"	(\a->a.ProjectOptions.verbose)	(\v a->{ProjectOptions | a & verbose=v})
	}

PathName :: OptionsTableEntry {#Char}
PathName
	=	SimpleOption "Path"	id const

ModuleName :: OptionsTableEntry {#Char}
ModuleName
	=	SimpleOption "Module" id const

// MW..
ObjectFile :: OptionsTableEntry {#Char}
ObjectFile
	=	SimpleOption "ObjectFile" id const

Library :: OptionsTableEntry {#Char}
Library
	=	SimpleOption "Library" id const
//..MW

LinkOptionsTable :: OptionsTable LinkOptions
LinkOptionsTable	=
	{
		SimpleOption "DefaultSystemObjects"					(\a->a.useDefaultSystemObjects)	(\v a->{a & useDefaultSystemObjects=v}),
		SimpleOption "DefaultLibraries"						(\a->a.useDefaultLibraries)		(\v a->{a & useDefaultLibraries=v}),
		ListOption	 "ExtraObjects"				PathName ""	(\a->a.extraObjectModules)		(\v a->{a & extraObjectModules=v}),
		ListOption	 "ExtraLibraries"			PathName ""	(\a->a.libraries)				(\v a->{a & libraries=v})
	}

EditWdOptionsTable :: OptionsTable EditWdOptions
EditWdOptionsTable	=
	{
		GroupedOption "Editor"			EditOptionsTable	(\a->a.eo)			(\v a->{a & eo=v}),
		GroupedOption "WindowPosition"	WindowPositionTable	(\a->a.pos_size)	(\v a->{a & pos_size=v})
	}

EditOptionsTable :: OptionsTable EditOptions
EditOptionsTable	=
	{
		SimpleOption "TabSize"		(\a->a.EditOptions.tabs)		(\v a->{EditOptions | a & tabs=v}),
		SimpleOption "Font"			(\a->a.EditOptions.fontname)	(\v a->{EditOptions | a & fontname=v}),
		SimpleOption "FontSize"		(\a->a.EditOptions.fontsize)	(\v a->{EditOptions | a & fontsize=v}),
		SimpleOption "AutoIndent"	(\a->a.EditOptions.autoi)		(\v a->{EditOptions | a & autoi=v})
	}

WindowPositionTable :: OptionsTable WindowPos_and_Size
WindowPositionTable	=
	{
		SimpleOption "X"		(\a->a.posx)	(\v a->{a & posx=v}),
		SimpleOption "Y"		(\a->a.posy)	(\v a->{a & posy=v}),
		SimpleOption "SizeX"	(\a->a.sizex)	(\v a->{a & sizex=v}),
		SimpleOption "SizeY"	(\a->a.sizey)	(\v a->{a & sizey=v})
	}

SaveDefaultSettings	:: !Editor !*Files -> (!Editor, !*Files);
SaveDefaultSettings editor=:{defaults} files
	# (opened, file, files)
		=	fopen PrefsPath FWriteText files
	| not opened
		=	(editor, files)
	# defaults
		=	{defaults & paths = Map (replace_prefix_path editor.startupinfo.startupdir "{Application}") defaults.paths}
	# file
		=	WriteOptionsFile (PutOptions DefaultOptionsTable defaults) file
	# (_, files)
		=	fclose file files
	=	(editor, files)	

SaveProjectFile	:: !Pathname !Project !Pathname !*Files -> (!Bool, !*Files);
SaveProjectFile	projectPath project appDir files
	# (opened, file, files)
		=	fopen projectPath FWriteText files
	| not opened
		=	(False, files)
	# (applicationDir, files)
		=	FStartUpDir ApplicationName files
	  projectDir
	  	=	RemoveFilename projectPath

	# options
	  	=	PutOptions ProjectTable (GetProject applicationDir projectDir project)
	# file
		=	WriteOptionsFile options file
	# (closed, files)
		=	fclose file files
	| not closed
		=	(False, files)
	| otherwise
		=	(True, files)

ReadVersion :: *File -> (!{#Char}, !*File)
ReadVersion file
	# (string, file)
		=	readLine file
	| EqualPrefix "Version:" string
		=	(ConvertToString string, file)
	| otherwise
		=	("", file)

CopyFile::String String *Files -> *Files
CopyFile source dest files
	|	not sopen	= 	files1
	|	not dopen	= 	files2
	|	io_error	= 	files4
	|	not dclose	= 	files4
	|	not sclose	= 	files4
					= 	files4
where
	(sclose,files4)         	= fclose sfile` files3
	(dclose,files3)         	= fclose dfile` files2
	(io_error,sfile`,dfile`)	= copyChars sfile dfile
	(dopen,dfileText,files2)  	= fopen dest FWriteText files1
	(_, dfile)					= freopen dfileText FWriteData
	(sopen,sfile,files1)    	= fopen source FReadData files

	copyChars ::*File *File -> (Bool, *File, *File)
	copyChars source dest
		| srcend || wrterror	=  (wrterror,source1,dest1)
								=  copyChars source2 (fwritec byte dest1)
	where 
		(_,byte,source2)	= freadc source1
		(srcend,source1)   	= fend source
		(wrterror,dest1)   	= ferror dest

// +++ add error handling
ReadDefaultSettings	:: !Editor !*Files -> (!Editor, !*Files)
ReadDefaultSettings editor=:{defaults} files
	# (opened, file, files)
		=	fopen PrefsPath FReadData files
	| not opened
		=	(editor, files)

	# (version, file)
		=	ReadVersion file
	| version == ""
		# (_, files)
			=	fclose file files
		# files
			=	CopyFile PrefsPath (PrefsPath+++".old") files
		=	OldReadDefaultSettings editor files

	# (options, file)
		=	ReadOptionsFile file
	# editor
		=	{editor & defaults = GetOptions DefaultOptionsTable options defaults}
	# editor
		=	{editor & defaults.paths = Map (replace_prefix_path "{Application}" editor.startupinfo.startupdir) editor.defaults.paths}
	# (_, files)
		=	fclose file files
	=	(editor, files)

// +++ add error handling
ReadProjectFile	:: !Pathname !(List Pathname) !Pathname !*Files -> ((!Project, !Bool),!*Files);
ReadProjectFile path defDirs applicationDirName files
	# (opened, file, files)
		=	fopen path FReadData files
	  emptyProject
		=	PR_InitProject
	| not opened
		=	((emptyProject, opened), files)

	# (version, file)
		=	ReadVersion file
	| version == ""
		# (_, files)
			=	fclose file files
		# files
			=	CopyFile path (path+++".old") files
		=	OldReadProjectFile  path defDirs applicationDirName files

	# (options, file)
		=	ReadOptionsFile file
	# (applicationDir, files)

		=	FStartUpDir ApplicationName files
	# project
		=	SetProject applicationDir projectDir
				(GetOptions ProjectTable options (GetProject applicationDir projectDir emptyProject))
		with
			projectDir
		  		=	RemoveFilename path
	# (closed, files)
		=	fclose file files
	| not closed
		=	((project, opened), files)
	=	((project, closed), files)

:: OptionDiagnostics
		=	MissingOption
		|	UnknownOption
		|	RedefinedValue
		|	IllegalValue
		|	IllegalSubOptions

GetOptions :: !(OptionsTable a) [Option] a -> a
GetOptions table [] value
	=	value
GetOptions table [option : options] value
	=	GetOptions table options (GetOption table option value)

GetOption :: (OptionsTable a) Option !a -> a
GetOption table (Option _ {label=labelName} value subOptions) currentValue
	=	case [optionEntry \\ optionEntry <-: table | optionEntry.labelName == labelName] of
			[]
				->	currentValue
			[{conversions={fromValue}, get, put} : _]
				->	put (fromValue value subOptions (get currentValue)) currentValue

PutOptions :: (OptionsTable a) a -> [Option]
PutOptions table a
	=	putOptions 0
	where
		tableSize
			=	size table
		putOptions i
			| i >= tableSize
				=	[]
			// otherwise
				=	case (PutOption a table.[i]) of
						Nothing
							->	putOptions (i+1)
						Just option
							->	[option : putOptions (i+1)]
				
PutOption :: a (OptionsTableEntry a) -> MayBe Option
PutOption value {labelName, conversions={toValue}, get}
	=	(case (toValue (get value)) of
			(Nothing, [])
				->	Nothing
			(value, subOptions)
				->	Just (Option 0 {label=labelName} value subOptions))
