implementation module edfiles

import StdArray,StdFunc,StdMisc,StdTuple
import StdFileSelect,StdMenuElement,StdPStClass,StdReceiver
import ExtNotice
import EdClient, EdWindow, EdMouse, EdFile
import EdText, EdKeyboard, EdSelection
import PmPath, PmParse
import IDE, IdePlatform
import filehist
import ioutil
import StrictList
import menubar
import UtilNewlinesFile
//import treeparse //P4

//--

ed_ask_save_all :: !Bool (*(PSt General) -> *PSt General) !*(PSt General) -> *PSt General
ed_ask_save_all close cont pstate
	#	(windows,pstate)	= accPIO getWindowsStack pstate
	= doall windows pstate
where
	maybeclose win ps
		| close	= ed_common_close True win ps
				= ps
	doall [] ps = cont ps
	doall [win:res] ps
		#	(ns,ps)		= message win msgGetNeedSave ps
		| isNothing ns
			= doall res ps
		#	needsave	= fromJust ns
		| not needsave
			= doall res (maybeclose win ps)
		#	(mr,ps)		= message win msgGetPathName ps
		| isNothing mr
			= doall res ps
		#	pathname	= fromJust mr
			texts		= ["Save changes to","\""+++RemovePath pathname+++"\"?"]
		= ask texts win res ps

	save win ps
		# (reply,ps)		= message win msgSave ps
		| isNothing reply
			= okNotice ["Save failed:","Internal error [edfiles:ed_ask_save_all]"] ps
		# error				= fromJust reply
		| isJust error
			= okNotice ["Save failed:",fromJust error] ps
		= ps

	ask texts win res ps
		#	(sId,ps)		= openId ps
		#	(okId,ps)		= openId ps
		#	(cancelId,ps)	= openId ps
			((err,_),ps)	= openModalDialog Void (sdef sId okId cancelId) ps
		| err <> NoError
			// error handling
			// # ps = trace_n "dialog open err" ps
			= ps
		= ps
	where
		sdef sId okId cancelId =
			Dialog "Save changes?"
			(	ListLS	[TextControl txt [ControlPos (Left,zero)]
						\\ txt <- texts
						]
			:+: ButtonControl "&Cancel"
				[ ControlPos (Left,zero)
				, ControlFunction (noLS (mb_update_undoinfo o closeWindow sId))
				, ControlId cancelId
				, ControlWidth (ContentWidth "Cancel")
				]	// no more
			:+: ButtonControl "&No"
				[ ControlFunction (noLS (doall res o maybeclose win o (closeWindow sId)))
				, ControlWidth (ContentWidth "Cancel")
				]	// not this one but continue with rest
			:+: ButtonControl "&Yes"
				[ ControlId okId
				, ControlFunction (noLS (doall res o maybeclose win o save win o (closeWindow sId)))
				, ControlWidth (ContentWidth "Cancel")
				]	// do this one and continue
			)
			[ WindowId sId
			, WindowOk okId				// DvA: Doesn't work properly yet. Will be fixed in Object IO
			, WindowCancel cancelId
			, WindowClose (noLS (mb_update_undoinfo o closeWindow sId))
			, WindowInitActive okId
			]

ed_open_path_sel :: .String !Selection !*(PSt General) -> *PSt General
ed_open_path_sel pathName sel ps
	# (mFHrecId,ps)	= getFHI ps
	# (_,ps)		= syncSend2 mFHrecId pathName ps
	= ed_open_cont pathName cont ps
where
	cont _ win ps
		# (_,ps) = message win (msgChangeSelection sel) ps
		= ps

ed_open_path :: .String !*(PSt General) -> *PSt General
ed_open_path pathName ps
	# (mFHrecId,ps) = getFHI ps
	# (_,ps)		= syncSend2 mFHrecId pathName ps
	= ed_open_cont pathName cont ps
where
	cont _ _ ps = ps

ed_open_cont :: .String .(Bool  Id *(PSt General) -> *PSt General) !*(PSt General) -> *PSt General
ed_open_cont pathName cont ps
	// should first check wether this one already exists...
	# (windows,ps)	= accPIO getWindowsStack ps
	# (exists,ps)	= doall windows ps
	| isJust exists
		// bring to front...allready done by 'doall'
		= cont True (fromJust exists) ps
	// read the file from disk
	# ((errorText,nlConv,readOnly), ps)
					= readText pathName ps
	| isError errorText
		= okNotice
			[ "Clean Project Manager"
			, "Error while reading file:"
			, pathName
			, giveError errorText				// for debugging purposes only?
			] ps
	# text			= fromOk errorText
	# modname		= GetModuleName pathName
	# isDefMod		= IsDefPathname pathName
	# isImpMod		= IsImpPathname pathName
	# (inf,ps)		= accProject (\l->(PR_GetModuleInfo modname l,l)) ps
	# (prefs,ps)	= getPrefs ps
	# defaultFontdef= prefs.edwinfont
	# fontdef		= defaultFontdef
	# tabs			= prefs.edwintabs
	// open a font and then the edit window
	# (font,ps)		= accScreenPicture (safeOpenFixedFont defaultFontdef) ps
	// error checking op font doen...?
	# title			= pathNameToWindowTitle pathName
	# title`		= pathNameToWindowTitle` pathName
	# (windowId, ps)= openId ps 
	# ({mn_und},ps)	= getMenuIds ps
	# keyboardfun	= if readOnly my_keyboard` my_keyboard
	# windowIcon	= if isDefMod DefmodIcon (if isImpMod ImpmodIcon CleanIcon)
	# syncols		= if isDefMod (prefs.defcols) (if isImpMod (prefs.impcols) (prefs.syncols))
//    # (boom, ps) 	= readFileInTree ps	// P4
	# ps			= openEditWindow mn_und (if readOnly title` title) pathName text font tabs syncols windowId (
						[ WindowClose		(noLS (ed_close windowId))
						, WindowKeyboard	(\_ -> True) Able keyboardfun
						, WindowActivate	(ed_activate title)
						, WindowDeactivate	(ed_deactivate title)
						, WindowInit		(noLS (SetWindowIcon windowId windowIcon))
						, WindowMouse		noMouseMoved Able editWindowMouse	//(editWindowMouse boom) // P4
						] ++ (if (isJust inf)
							[ WindowViewSize		(if isDefMod
								{w=(fromJust inf).defeo.pos_size.sizex,h=(fromJust inf).defeo.pos_size.sizey}
								{w=(fromJust inf).impeo.pos_size.sizex,h=(fromJust inf).impeo.pos_size.sizey})
							, WindowPos			(if isDefMod
								(Fix,OffsetVector {vx=(fromJust inf).defeo.pos_size.posx,vy=(fromJust inf).defeo.pos_size.posy})
								(Fix,OffsetVector {vx=(fromJust inf).impeo.pos_size.posx,vy=(fromJust inf).impeo.pos_size.posy}))
							]
							[])
						) ps
	# (_,ps)		= message windowId (setNewlineConvention nlConv) ps
	# (_,ps)		= message windowId (setReadOnly readOnly) ps
	= cont False windowId ps
where
	doall [] ps = (Nothing,ps)
	doall [win:res] ps
		#	(mr,ps)		= message win msgGetPathName ps
		| isNothing mr
			= doall res ps
		#	pathname`	= fromJust mr
		| pathName == pathname`
			#	ps	= setActiveWindow win ps
			= (Just win,ps)
		= doall res ps

	giveError (Error s) = s
	giveError _ = ""

ed_activate :: !String !*(!EditState,!*PSt General) -> *(EditState,*PSt General)
ed_activate title (ls,ps)
	# (menuIds,ps)			= getMenuIds ps
	# (undoInfo,(ls,ps))	= getUndoInfo (ls,ps)
	# (pathname,(ls,ps))	= getPathName (ls,ps)

	# (text,(ls,ps))		= getText (ls,ps)
	# (sel,(ls,ps))			= getSelection (ls,ps)
	# sel					= orderSelection sel
	# (frag,_)				= getTextFragment sel text
	# frag					= dofrag frag
	# (_,(ls,ps))			= setMenuSelection frag (ls,ps)

	# iofun					= case undoInfo.state of
								None	-> disableMenuElements [menuIds.mn_und] o setMenuElementTitles [(menuIds.mn_und,"&Undo")]
								Undo	-> enableMenuElements [menuIds.mn_und] o setMenuElementTitles [(menuIds.mn_und,"&Undo"+++undoInfo.action)]
								Redo	-> enableMenuElements [menuIds.mn_und] o setMenuElementTitles [(menuIds.mn_und,"Redo"+++undoInfo.action)]
	# filename				= RemovePath pathname
	#! ps					= appPIO
								( iofun
								o setMenuElementTitles
									[(menuIds.mn_sav,"&Save " +++filename)
									,(menuIds.mn_rev,"&Revert " +++filename)
									,(menuIds.mn_oth,"Open " +++(makeOther filename))
									,(menuIds.mn_prt,"&Print " +++ filename)
									: handlefrag frag menuIds
									]
								o enableMenuElements
									[ menuIds.mn_sav
									, menuIds.mn_sva
									, menuIds.mn_rev
									, menuIds.mn_oth
									, menuIds.mn_prt
									, menuIds.md_est
									: ismodule pathname (menuIds.moduleIds) []
									]
								) ps
	= (ls,ps)
where
	ismodule s t f
		| lengths < 4
			= f
		| s%(firsts,lasts) == ".icl"
			= t
//		| s%(firsts,lasts) == ".dcl"
//			= t
		= f
	where
		lengths = size s
		firsts = lengths - 4
		lasts = dec lengths
	dofrag (SCons (str) SNil) 
		| CleanModId str
			= Just str
		= Nothing
	dofrag _ = Nothing
	handlefrag (Just str) mIds
		=
			[(mIds.mn_odm,"Open "+++(MakeDefPathname str))
			,(mIds.mn_oim,"Open "+++(MakeImpPathname str))
			]
	handlefrag _ mIds =
			[(mIds.mn_odm,"Open Definition...")
			,(mIds.mn_oim,"Open Implementation...")
			]

makeOther pth
	| IsDefPathname pth = MakeImpPathname pth
	= MakeDefPathname pth

ed_deactivate title (ls,ps)
	# (menuIds,ps)	= getMenuIds ps
	# ps			= appPIO
						( setMenuElementTitles
							[ (menuIds.mn_sav,"&Save")
							, (menuIds.mn_rev,"&Revert")
							, (menuIds.mn_oth,"Open Other")
							, (menuIds.mn_odm,"Open Definition...")
							, (menuIds.mn_oim,"Open Implementation...")
							, (menuIds.mn_prt,"&Print")
							, (menuIds.mn_und,"&Undo")
							]
						o disableMenuElements
							[ menuIds.mn_sav
							, menuIds.mn_sva
							, menuIds.mn_rev
							, menuIds.mn_oth
							, menuIds.mn_prt
							, menuIds.mn_und
							, menuIds.md_est
							: menuIds.moduleIds
							]
						) ps
	= (ls,ps)

ed_new :: !String !*(PSt General) -> *PSt General
ed_new suffix ps
	// ask user for a file to open
	#	(maybeString, ps) = selectOutputFile "New..." suffix ps
	| isNothing maybeString
		= ps
	#	pathName			= fromJust maybeString
		text				= newText
		title				= pathNameToWindowTitle pathName
		(windowId, ps)		= accPIO openId ps
	#	({mn_und},ps)		= getMenuIds ps
		(prefs,ps)			= getPrefs ps
		defaultFontdef		= prefs.edwinfont
		defaultTabs			= prefs.edwintabs
	#	isDefMod			= IsDefPathname pathName
	#	isImpMod			= IsImpPathname pathName
	#	defaultSync			= if isDefMod (prefs.defcols) (if isImpMod (prefs.impcols) (prefs.syncols))
	
		((_, defaultFont), ps)
							= accPIO (accScreenPicture (openFont defaultFontdef)) ps
//    # (boom, ps) 	= readFileInTree ps	// P4
	#	ps					= openEditWindow mn_und title pathName text defaultFont defaultTabs defaultSync windowId 
								[ WindowClose		(noLS (ed_close windowId))
								, WindowKeyboard	(\_ -> True) Able (my_keyboard)
								, WindowActivate	(ed_activate title)
								, WindowDeactivate	(ed_deactivate title)
								, WindowMouse		noMouseMoved Able editWindowMouse	//(editWindowMouse boom)
								] ps
	# nlConv = case prefs.newline_handling of
				(LeaveAlone NewlineConventionNone)	-> HostNativeNewlineConvention
				(LeaveAlone conv)					-> conv
				(AlwaysUse NewlineConventionNone)	-> HostNativeNewlineConvention
				(AlwaysUse conv)					-> conv
	#	(_,ps)				= message windowId (setNewlineConvention nlConv) ps
  	#	(reply,ps)				= message windowId msgSave ps
  	| isNothing reply
  		# ps = okNotice ["File creation failed","Internal error [edfiles:ed_new]"] ps
  		# ps = ed_common_close False windowId ps
  		= ps
  	# error					= fromJust reply
  	| isJust error
  		# ps = okNotice ["File creation failed",fromJust error] ps
  		# ps = ed_common_close False windowId ps
  		= ps
	# (mFHrecId,ps)			= getFHI ps
	# (_,ps)				= syncSend2 mFHrecId pathName ps
  = ps

ed_close :: !Id !*(PSt General) -> *PSt General
ed_close win ps
	#	(mr,ps)		= message win msgGetPathName ps
	| isNothing mr
		= ps
	#	pathname	= fromJust mr
		(ns,ps)		= message win msgGetNeedSave ps
	| isNothing ns
		= ed_common_close True win ps
	#	needsave	= fromJust ns
	| not needsave
		= ed_common_close True win ps
	#	texts		= ["Save changes to","\""+++RemovePath pathname+++"\"","before closing?"]
		ps			= ask texts win ps
	= ps
where
	save_cont win sId ps
		# ps			= closeWindow sId ps
		# (reply,ps)	= message win msgSave ps
		| isNothing reply
			# (cnId,ps) = openId ps
			# (_,ps)	= openModalDialog Void (edef ["Save failed.","Internal error [edfiles:ed_close]"] sId cnId) ps
			= ps
		# error			= fromJust reply
		| isJust error
			# (cnId,ps) = openId ps
			# (_,ps)	= openModalDialog Void (edef ["Save failed.",fromJust error] sId cnId) ps
			= ps
		# ps			= ed_common_close True win ps
		= ps
	buttonWidth = ContentWidth "Cancel"
	ask texts win ps
		#	(sids,ps)	= accPIO (openIds 3) ps
			(_,ps)	= openModalDialog undef (sdef sids) ps
		= ps
	where
		sdef [sId,okId,cancelId:_] = Dialog "Save changes?"
				(	ListLS [TextControl txt [ControlPos (Left,zero)]
					\\ txt <- texts
					]
				:+: ButtonControl "&Cancel"
					[ ControlPos (Left,zero)
					, ControlId cancelId
					, ControlFunction (noLS (closeWindow sId))
					]	// no more
				:+: ButtonControl "&No"
					[ ControlFunction (noLS (ed_common_close True win o (closeWindow sId)))
					]
				:+: ButtonControl "&Yes"
					[ ControlId okId
					, ControlFunction (noLS (save_cont win sId))
					]	// do this one and continue
				)
				[ WindowOk okId
				, WindowCancel cancelId
				, WindowId sId
				, WindowClose (noLS (closeWindow sId))
				, WindowInitActive okId
				]
		sdef _ = abort "edfiles: not enough ids"
	edef texts sId cnId = Dialog ""
		(	ListLS [TextControl txt [ControlPos (Left,zero)]
			\\ txt <- texts
			]
		:+: ButtonControl "Cancel"
			[ ControlPos (Left,zero)
			, ControlFunction (noLS (closeWindow sId))
			, ControlWidth buttonWidth
			, ControlId cnId
			]	// no more
		:+: ButtonControl "Close"
			[ ControlFunction (noLS (ed_common_close True win o (closeWindow sId)))
			, ControlWidth buttonWidth
			]	// not this one but continue with rest
		)
		[ WindowCancel cnId
		, WindowId sId
		]

ed_common_close :: !Bool !Id !*(PSt General) -> *PSt General
ed_common_close update_in_project win ps
	# (clip,ps) = cw_maybe_close win ps
	| clip
		= ps	// ???
	# (active,ps) = accPIO getActiveWindow ps
	# (_,ps) = case active of
				Nothing	-> (active,ps)
				(Just act)	-> (if (act==win) (ed_deactivate "???") id) (active,ps)
	// update win info in project
	# (nam,ps)	= message win msgGetPathName ps
	| isNothing nam
		# ps = okTimedNotice ["ed_common_close error 1"] 3000 ps
		= closeEditWindow win ps	// this should not occur
	# nam		= fromJust nam	
	# (pos,ps)	= accPIO (getWindowPos win) ps
	| isNothing pos
		# ps = okTimedNotice ["ed_common_close error 2"] 3000 ps
		= closeEditWindow win ps	// this should not occur
	# pos		= fromJust pos
	# (siz,ps)	= accPIO (getWindowViewSize win) ps
	# modname	= GetModuleName nam
	# isDefmod	= IsDefPathname nam
	# pos_size	= {posx = pos.vx,posy=pos.vy,sizex=siz.w,sizey=siz.Size.h}
	# update	= \inf=:{defeo,impeo} -> if isDefmod
					{inf & defeo = {defeo & pos_size = pos_size}, defopen = not update_in_project}
					{inf & impeo = {impeo & pos_size = pos_size}, impopen = not update_in_project}
	# ps		= appProject (\p -> PR_UpdateModule modname update p) ps
	= closeEditWindow win ps

ed_save :: !Id !*(PSt General) -> (!Bool,!*PSt General)
ed_save win ps
	#	(reply,ps)			= message win msgSave ps
	| isNothing reply
		# ps = okNotice ["Save failed:","Internal error [edfiles:ed_save]"] ps
		= (False,ps)	// shouldn't happen
	# error = fromJust reply
	| isNothing error
		= (True,ps)
	# ps = okNotice ["Save failed:",fromJust error] ps
	= (False,ps)

ed_save_as :: !*(PSt General) -> *PSt General
ed_save_as ps
	# (win,ps)				= accPIO getActiveWindow ps
	| isNothing win
		= ps
	# win					= fromJust win
	# (isEdit,ps)			= isEditWin win ps
	| not isEdit
		= ps
	# (mpath,ps)			= message win msgGetPathName ps
	| isNothing mpath
		= ps
	# o_pathname			= fromJust mpath
	# (maybeString, ps) 	= selectOutputFile "Save as:" o_pathname ps
	| isNothing maybeString
		= ps
	# pathname				= fromJust maybeString
	# (_,ps)				= message win (setReadOnly False) ps
	# (_,ps)				= message win (msgSetPathName pathname) ps
	# (reply,ps)			= message win (msgSave) ps
	| isNothing reply
		= okNotice ["Save as failed:","Internal error [edfiles:ed_save_as]"] ps
	# error					= fromJust reply
	| isJust error
		= okNotice ["Save as failed:",fromJust error] ps

	# (prefs,ps)			= getPrefs ps
	# cols					= if (IsDefPathname pathname) (prefs.defcols) (if (IsImpPathname pathname) (prefs.impcols) (prefs.syncols))
	# (_,ps)				= message win (appFontInfo (fi_update cols)) ps
	# ps					= appPIO (updateWindow win Nothing) ps

	# (menuIds,ps)			= getMenuIds ps
	# filename				= RemovePath pathname
	# ps					= appPIO
								( setMenuElementTitles
									[(menuIds.mn_sav,"&Save " +++filename)
									,(menuIds.mn_rev,"&Revert " +++filename)
									,(menuIds.mn_oth,"Open " +++(makeOther filename))
									,(menuIds.mn_prt,"&Print " +++ filename)
									]
								) ps
	# (mFHrecId,ps)			= getFHI ps
	# (_,ps)				= syncSend2 mFHrecId pathname ps
	= ps
where
	fi_update cols fi =
		{ fi
		& syntaxColours =
			{ fi.syntaxColours
			& textColour		= cols.textColour
			, tabColour			= cols.tabColour
			, commentColour		= cols.commentColour
			, stringColour		= cols.stringColour
			, charColour		= cols.charColour
			, backgroundColour	= cols.backgroundColour
			, keywordColour		= cols.keywordColour
			}
		}

ed_save_copy_as :: !*(PSt General) -> *PSt General
ed_save_copy_as ps
	# (win,ps)				= accPIO getActiveWindow ps
	| isNothing win
		= ps
	# win					= fromJust win
	# (isEdit,ps)			= isEditWin win ps
	| not isEdit
		= ps
	# (mpath,ps)			= message win msgGetPathName ps
	| isNothing mpath
		= ps
	# pathname				= fromJust mpath
	# (maybeString, ps) 	= selectOutputFile "Save Copy As:" pathname ps
	| isNothing maybeString
		= ps
	# pathName				= fromJust maybeString
	# (reply,ps)				= message win (msgSaveTo pathName) ps
	| isNothing reply
		= okNotice ["Save copy as failed:","Internal error [edfiles:ed_save_copy_as]"] ps
	# error					= fromJust reply
	| isJust error
		= okNotice ["Save copy as failed:",fromJust error] ps
	= ps

ed_save_all :: !*(PSt General) -> *PSt General
ed_save_all pstate
	# (windows,pstate)	= accPIO getWindowsStack pstate
	= doall windows pstate
where
	doall [] ps = ps
	doall [win:res] ps
		# (isEdit,ps)		= isEditWin win ps
		| not isEdit
			= doall res ps
		#! (reply,ps)		= message win msgSave ps
		| isNothing reply
			# ps 			= okNotice ["Save failed:","Internal error [edfiles:ed_save_all]"] ps
			= doall res ps
		# error				= fromJust reply
		| isJust error
			# ps			= okNotice ["Save failed:",fromJust error] ps
			= doall res ps
		= doall res ps

ed_print_setup :: !*(PSt General) -> *PSt General
ed_print_setup ps
	# (setup,ps)	= getPrintSetup ps
	# (setup,ps)	= printSetupDialog setup ps
	= setPrintSetup setup ps

ed_print :: !*(PSt General) -> *PSt General
ed_print ps
	# (printSetup,ps)	= getPrintSetup ps
	# (res,ps)			= sendToActiveWindow (msgPrint printSetup) ps
	| isJust res
		# printSetup = fromJust res
		# ps = setPrintSetup printSetup ps
		= ps			// success
	// try something else...
	= ps

ed_print_all :: !*(PSt General) -> *PSt General
ed_print_all pstate
	# (printSetup,pstate)	= getPrintSetup pstate
	#	(windows,pstate)	= accPIO getWindowsStack pstate
	= doall printSetup windows pstate
where
	doall printSetup [] ps = setPrintSetup printSetup ps
	doall printSetup [win:res] ps
		# (rep,ps)		= message win (msgPrint printSetup) ps
		| isNothing rep
			= doall printSetup res ps
		# printSetup = fromJust rep
		= doall printSetup res ps

ed_revert :: !*(PSt General) -> *PSt General
ed_revert ps
	#	(win,ps)				= accPIO getActiveWindow ps
	| isNothing win = ps
	= ed_revert_win (fromJust win) ps

ed_revert_win :: !Id !*(PSt General) -> *PSt General
ed_revert_win win ps
	#	(mpath,ps)				= message win msgGetPathName ps
	| isNothing mpath
		= ps
	#	pathName				= fromJust mpath
	// read the file from disk
	#	((errorText,nlConv,_), ps)			= readText pathName ps
	| isError errorText
		= openNotice (Notice
			[ "Clean Project Manager"
			, "Error while reading file:"
			, pathName
			, giveError errorText				// only for debugging purposes
			]
			(NoticeButton "OK" id)
			[]) ps
	#	text					= fromOk errorText
		(_,ps)					= message win (msgRevertText text) ps
		(_,ps)					= message win (setNewlineConvention nlConv) ps
	= mb_update_undoinfo ps
where
	giveError (Error s) = s
	giveError _ = ""


//--

my_keyboard ks (es,ps)
	# (ed,ps)				= getEditorState ps
	# keyMapping			= getKeyMapping ed
	= editWindowKeyboard keyMapping ks (es,ps)

my_keyboard` ks (es,ps)
	# (ed,ps)				= getEditorState ps
	# keyMapping			= getKeyMapping ed
	= noeditWindowKeyboard keyMapping ks (es,ps)

