implementation module IdeState

import ExtListBox, FilteredListBox
import EdState
import PmPath, PmProject, PmPrefs, PmFileInfo
import clipboard, typewin, fbi, PmAbcMagic, errwin
import flextextcontrol, ioutil, UtilStrictLists
from PmCleanSystem import ::CompilerProcessIds,NoCompilerProcessIds
from StdPStClass import instance FileEnv (PSt .l)

:: InfoDialogInfo =
	{pr_info	:: !Id								// id for info dialog
	,pr_text1	:: !Id								// id for info dialog text
	,pr_text2	:: !Id								// id for info dialog text
	,pr_text3	:: ![Id]							// id for info dialog text
	,pr_trig	:: !Id								// id for interrupt trigger
	}
	
:: *General =
  ! {pr_path	:: !Pathname						// pathname current project
	,pr_stup	:: !Pathname						// startupdirectory

	,pr_idi		:: !InfoDialogInfo
	
	,pr_wwid	:: !Id								// id for proj window
	,pr_xxid	:: !FlexId							// id for exec path text control
	,pr_mmid	:: !FlexId							// id for main mod text control
	,pr_list	:: !ExtListBoxId (PSt General)		// listbox id

	,ed_stat	:: !EditorState						// om editor aan te hangen
	,ed_find	:: !FindInfo						// regular find info
	,fb_info	:: !(FindBoxInfo (PSt General))		// clean-savvy find info
	,er_info	:: !(ErrorInfo (PSt General)) 		// info for error window
	,ed_clip	:: !ClipInfo
	,tw_info	:: !TypeWinInfo
	,cons_info	:: !ConsWinInfo

	,pm_targets	:: ![Target]
	,tg_menuid	:: !Id
	,tg_radioid	:: !Id
	,pm_curtarg :: !Int
	,prefs		:: !Prefs

	,mn_ids		:: !MenuIds
	
	,callback	:: Bool (PSt General) -> (PSt General)
	,abc_cache	:: !*(Maybe ABCCache)
	,fi_cache	:: !(Maybe FileInfoCache)
	
	,print_setup :: !MaybePrintSetup
	
	,project	:: !Project
	,g_compiler_process_ids :: !CompilerProcessIds
	
	, prefix	:: ![String]						// prefixes for add/rem prefix
	, interact	:: Bool
	, logfile	:: *File
	
	, fstate	:: ![(!Bool,!String)]
	}

:: MaybePrintSetup = NoPrintSetup | PrintSetup !PrintSetup;

getFstate :: !*(PSt *General) -> ([(!Bool,!String)],*(PSt *General))
getFstate ps = accPLoc (\l=:{fstate}->(fstate,l)) ps

setFstate :: ![(!Bool,!String)] !*(PSt *General) -> *(PSt *General)
setFstate fs ps = appPLoc (\l->{l & fstate = fs}) ps

getProject :: !*(PSt *General) -> (Project,*(PSt *General))
getProject ps = accPLoc (\l=:{project}->(project,l)) ps

setProject :: !Project !*(PSt *General) -> *(PSt *General)
setProject prj ps = appPLoc (\l->{l & project = prj}) ps

appProject :: (Project -> Project) !*(PSt *General) -> *(PSt *General)
appProject f ps = appPLoc (\l=:{project}->{l & project = f project}) ps

accProject :: (Project -> (.a,Project)) !*(PSt *General) -> (.a,*(PSt *General))
accProject f ps
	# (prj,ps) = ps!ls.project
	# (res,prj) = f prj
	= (res,{ps & ls.project = prj})

getCompilerProcessIds :: !*(PSt *General) -> (!CompilerProcessIds,!*(PSt *General))
getCompilerProcessIds ps = accPLoc (\l -> l!g_compiler_process_ids) ps

setCompilerProcessIds :: !CompilerProcessIds !*(PSt *General) -> *(PSt *General)
setCompilerProcessIds compiler_project_ids ps = appPLoc (\l -> {l & g_compiler_process_ids = compiler_project_ids}) ps
	
::EditMenuLS l =
	{ zfun :: (PSt l) -> PSt l
	, xfun :: (PSt l) -> PSt l
	, cfun :: (PSt l) -> PSt l
	, vfun :: (PSt l) -> PSt l
	}
::MIn l = MGet | MSet (EditMenuLS l)

:: MenuIds =
	{ mn_sav	:: !Id		// File:Save id
	, mn_sva	:: !Id		// File:Save As id
	, mn_rev	:: !Id		// File:Revert id
	, mn_clo	:: !Id		// File:Close id
	, mn_oth	:: !Id		// File:Open Other id
	, mn_odm	:: !Id		// File:Open Definition id
	, mn_oim	:: !Id		// File:Open Implementation id
	, mn_prt	:: !Id		// File:Print id
	, mn_prs	:: !Id		// File:PrintSetup id
	, mn_und	:: !Id		// Edit:Undo id
	, mn_cut	:: !Id		// Edit:Cut id
	, mn_cpy	:: !Id		// Edit:Copy id
	, mn_pst	:: !Id		// Edit:Paste id
	, mn_clr	:: !Id		// Edit:Clear id
	, mg_edt	:: ![Id]	// Edit:tools ids
	, searchIds	:: !SearchMenuIds	// Search: ids
	, pm_menuid	:: !Id		// id of project menu
	, projIds	:: ![Id]	// Project: ids for disabling when no project...
	, pm_listid	:: !Id		// id of project list (in project menu)
	, pm_mrecid :: !R2Id PLMMessage PLMReply	// id of project menu receiver
	, ed_mrecid :: !R2Id (MIn *General) (EditMenuLS *General)	// id of edit menu receiver
	,fh_rid :: !R2Id String [String]	// file history id
	,ph_rid :: !R2Id String [String]	// project history id
	, moduleIds	:: ![Id]	// ids in module menu
	, md_cmp	:: !Id		// Module:Compile
	, md_chk	:: !Id		// Module:Check syntax
	, md_gen	:: !Id		// Module:Generate assembly
	, md_cst	:: !Id		// Module:Compiler settings
	, md_est	:: !Id		// Module:Editor settings
	}

:: SearchMenuIds =
	{ srchIds	:: ![Id]
	, findIds	:: ![Id]
	, gotoIds	:: ![Id]
	, nextIds	:: ![Id]
	}

:: ErrorInfo p =
	{ errorId		:: !Id
	, infoId		:: !FilteredListBoxId
	, err_offset	:: !Vector2
	, err_font		:: !Font
	, err_size		:: !Size
	, err_forg		:: !Colour
	, err_back		:: !Colour
	, err_buttonId	:: !Id
	, err_countId	:: !Id
	, err_count		:: !Int
	, err			:: !Bool
	, wrn_buttonId	:: !Id
	, wrn_countId	:: !Id
	, wrn_count		:: !Int
	, wrn			:: !Bool
	, inf_buttonId	:: !Id
	, inf_countId	:: !Id
	, inf_count		:: !Int
	, inf			:: !Bool
	}

:: FindInfo =
	{ fi_find	:: ![String]		// find...
	, fi_repl	:: ![String]		// replace by
	, fi_ic		:: !Bool			// ignore case
	, fi_wa		:: !Bool			// wrap around
	, fi_bw		:: !Bool			// backward
	, fi_mw		:: !Bool			// match words
	, fi_re		:: !Bool			// temp: use regexp
	}

//---

iniGeneral :: !Prefs !.Pathname
				Bool *File
				!Id !Id !.(ExtListBoxId *(PSt *General)) !EditorState !.FindInfo
				!.(FindBoxInfo *(PSt *General)) !Id !Id !TypeWinInfo !ConsWinInfo !.[.Target] !Id !Id !(R2Id PLMMessage PLMReply) !*World//*env
				-> *(!ClipInfo,!*General,!*World)
iniGeneral
	prefs stup interact logfile mTargetId eTargetId lbId initEditorState emptyFindInfo ffind
	mEdUndoId mMdEdOptId iniTwi iniCons iniTargets mProjMenuId mProjListId mProjRecId env
	#	(infoId,env)	= openId env
		(text1Id,env)	= openId env
		(text2Id,env)	= openId env
		(text3Ids,env)	= openIds 3 env
		(trigId,env)	= openId env
		(wwId,env)		= openId env
		(xxId,env)		= openFlexId env
		(mmId,env)		= openFlexId env
		(fhId,env)		= openR2Id env
		(phId,env)		= openR2Id env
		(saveId,env)	= openId env
		(saveAsId,env)	= openId env
		(revertId,env)	= openId env
		(closeId,env)	= openId env
		(otherId,env)	= openId env
		(odefId,env)	= openId env
		(oimpId,env)	= openId env
		(printId,env)	= openId env
		(printSetupId,env)	= openId env
		(mEdCutId,env)	= openId env
		(mEdCopyId,env)	= openId env
		(mEdPasteId,env)	= openId env
		(mEdClearId,env)	= openId env
		(edToolsIds,env)	= openIds 8 env
		(mdCmpId,env)	= openId env
		(mdChkId,env)	= openId env
		(mdGenId,env)	= openId env
		(mdCstId,env)	= openId env
		(edmrecid,env)	= openR2Id env
	#	(errinfo,env)	= err_init prefs.err_prefs env
	# (srchIds,env)		= openIds 3 env
	# (findIds,env)		= openIds 4 env
	# (gotoIds,env)		= openIds 3 env
	# (nextIds,env)		= openIds 2 env
	# searchIds =
		{ srchIds = srchIds
		, findIds = findIds
		, gotoIds = gotoIds
		, nextIds = nextIds
		}
	# (projIds,env)		= openIds 17 env
	#	(iniClip,env) 	= initClipInfo mEdUndoId [mEdUndoId, mEdCutId, mEdCopyId, mEdPasteId, mEdClearId: edToolsIds ++ searchIds.findIds ++ searchIds.gotoIds] env
	# idi = 
		{ pr_info = infoId
		, pr_text1 = text1Id
		, pr_text2 = text2Id
		, pr_text3 = text3Ids
		, pr_trig = trigId
		}
	# gen ={ pr_path = ""
		, pr_stup = stup
		, pr_idi  = idi
		, pr_wwid = wwId
		, pr_xxid = xxId
		, pr_mmid = mmId
		, pr_list = lbId
		, ed_stat = initEditorState
		, ed_find = emptyFindInfo
		, fb_info = ffind
		, er_info = errinfo
		, ed_clip = iniClip
		, tw_info = iniTwi
		, cons_info = iniCons
		, pm_targets = iniTargets
		, tg_menuid = mTargetId
		, tg_radioid = eTargetId
		, pm_curtarg = 0
		, prefs = prefs
		, mn_ids =
			{ mn_sav = saveId
			, mn_sva = saveAsId
			, mn_rev = revertId
			, mn_clo = closeId
			, mn_oth = otherId
			, mn_odm = odefId
			, mn_oim = oimpId
			, mn_prt = printId
			, mn_prs = printSetupId
			, mn_und = mEdUndoId
			, mn_cut = mEdCutId
			, mn_cpy = mEdCopyId
			, mn_pst = mEdPasteId
			, mn_clr = mEdClearId
			, mg_edt = edToolsIds
			, searchIds = searchIds
			, pm_menuid = mProjMenuId
			, projIds = projIds
			, pm_listid = mProjListId
			, pm_mrecid = mProjRecId
			, ed_mrecid = edmrecid
			, fh_rid = fhId
			, ph_rid = phId
			, moduleIds	= []			// initially none enabled
			, md_cmp	= mdCmpId		// Module:Compile
			, md_chk	= mdChkId		// Module:Check syntax
			, md_gen	= mdGenId		// Module:Generate assembly
			, md_cst	= mdCstId		// Module:Compiler settings
			, md_est	= mMdEdOptId		// Module:Editor settings
			}
		, callback = (\_ ps -> ps)
		, abc_cache = Just AC_Init
		, fi_cache = Just FI_EmptyCache
		, print_setup = NoPrintSetup
		, project = PR_InitProject
		, g_compiler_process_ids=NoCompilerProcessIds
		, prefix = ["//\t"]
		, interact = interact
		, logfile = logfile
		, fstate = []
		}
	= (iniClip,gen,env)

//---

getABCCache :: !*(PSt *General) -> (*ABCCache,*PSt *General)
getABCCache ps = accPLoc (\p=:{abc_cache = Just abc_cache}->(abc_cache,{p & abc_cache = Nothing})) ps

setABCCache :: !*ABCCache !*(PSt *General) -> *PSt *General
setABCCache ac ps = appPLoc (\p->{p & abc_cache = Just ac}) ps

getFICache :: !*(PSt *General) -> (FileInfoCache,*PSt *General)
getFICache ps = accPLoc (\p=:{fi_cache = Just fi_cache}->(fi_cache,{p & fi_cache = Nothing})) ps

setFICache :: !FileInfoCache !*(PSt *General) -> *PSt *General
setFICache ac ps = appPLoc (\p->{p & fi_cache = Just ac}) ps

getCallback :: !*(PSt *General) -> *(.Bool -> *(PSt *General) -> *(PSt *General),*PSt *General);
getCallback ps = accPLoc (\p=:{callback}->(callback,p)) ps

setCallback :: (Bool -> *(PSt *General) -> *(PSt *General)) !*(PSt *General) -> *PSt *General;
setCallback cb ps = appPLoc (\p->{p & callback = cb}) ps

getFHI :: !*(PSt *General) -> (R2Id String [String],*PSt *General)
getFHI ps = accPLoc (\p=:{mn_ids=mi=:{fh_rid}}->(fh_rid,p)) ps

getPHI :: !*(PSt *General) -> (R2Id String [String],*PSt *General)
getPHI ps = accPLoc (\p=:{mn_ids=mi=:{ph_rid}}->(ph_rid,p)) ps

getMenuIds :: !*(PSt *General) -> (MenuIds,*PSt *General)
getMenuIds ps = accPLoc (\p=:{mn_ids}->(mn_ids,p)) ps

setModuleIds :: ![Id] !*(PSt *General) -> *PSt *General
setModuleIds ids ps = appPLoc (\p=:{mn_ids}->{p & mn_ids = {mn_ids & moduleIds = ids}}) ps

getEditRecId :: !*(PSt *General) -> *(R2Id (MIn *General) (EditMenuLS *General),*PSt *General)
getEditRecId ps = accPLoc (\p=:{mn_ids=mi=:{ed_mrecid}}->(ed_mrecid,p)) ps

setPrefs :: Prefs !*(PSt *General) -> *PSt *General
setPrefs p ps = appPLoc (\l->{l&prefs=p}) ps

getPrefs :: !*(PSt *General) -> (Prefs,*PSt *General)
getPrefs ps = accPLoc (\l=:{prefs}->(prefs,l)) ps

::PLMMessage
	= Add {#Char}
	| Rem {#Char}
	| Get

::PLMReply
	:== [{#Char}]

getPMI :: !*(PSt *General) -> ((Id,Id),*PSt *General)
getPMI ps = accPLoc (\l=:{mn_ids=mi=:{pm_menuid,pm_listid}}->((pm_menuid,pm_listid),l)) ps

getPMR :: !*(PSt *General) -> (R2Id PLMMessage PLMReply,*PSt *General)
getPMR ps = accPLoc (\l=:{mn_ids=mi=:{pm_mrecid}}->(pm_mrecid,l)) ps

getTargetIds :: !*(PSt *General) -> ((!Id,!Id),!*PSt *General)
getTargetIds ps = accPLoc (\p=:{tg_menuid,tg_radioid}->((tg_menuid,tg_radioid),p)) ps

getFBI :: !*(PSt *General) -> (!FindBoxInfo *(PSt *General),!*PSt *General)
getFBI ps = accPLoc (\p=:{fb_info}->(fb_info,p)) ps

setFBI :: !(FindBoxInfo *(PSt *General)) !*(PSt *General) -> *PSt *General
setFBI ts ps = appPLoc (\p->{p & fb_info = ts}) ps

setErrInfo :: !(ErrorInfo (PSt *General)) !*(PSt *General) -> *PSt *General
setErrInfo ei ps = appPLoc (\p->{p & er_info = ei}) ps

getErrInfo :: !*(PSt *General) -> (!(ErrorInfo (PSt *General)),!*PSt *General)
getErrInfo ps = accPLoc (\p=:{er_info}->(er_info,p)) ps

getPWI :: !*(PSt *General) -> (!ExtListBoxId (PSt General),!*PSt *General)
getPWI ps = accPLoc (\p=:{pr_list}->(pr_list,p)) ps

setPWI :: !(ExtListBoxId (PSt General)) !*(PSt *General) -> *PSt *General
setPWI ei ps = appPLoc (\p->{p & pr_list = ei}) ps

getPWW :: !*(PSt *General) -> (!Id,!*PSt *General)
getPWW ps = accPLoc (\p=:{pr_wwid}->(pr_wwid,p)) ps

getPWX :: !*(PSt *General) -> (!FlexId,!*PSt *General)
getPWX ps = accPLoc (\p=:{pr_xxid}->(pr_xxid,p)) ps

getPWM :: !*(PSt *General) -> (!FlexId,!*PSt *General)
getPWM ps = accPLoc (\p=:{pr_mmid}->(pr_mmid,p)) ps

getFI :: !*(PSt *General) -> (!FindInfo,!*PSt *General)
getFI ps = accPLoc (\p=:{ed_find}->(ed_find,p)) ps

setFI :: !FindInfo !*(PSt *General) -> *PSt *General
setFI ei ps = appPLoc (\p->{p & ed_find = ei}) ps

getPath :: !*(PSt *General) -> (!Pathname,!*PSt *General)
getPath ps = accPLoc (\p=:{General | pr_path}->(pr_path,p)) ps

setPath :: !Pathname !*(PSt *General) -> *PSt *General
setPath ts ps = appPLoc (\p->{General | p & pr_path = ts}) ps

getStup :: !*(PSt *General) -> (!Pathname,!*PSt *General)
getStup ps = accPLoc (\p=:{pr_stup}->(pr_stup,p)) ps

getInterrupt :: !*(PSt *General) -> (!(Id,Id),!*PSt *General)
getInterrupt ps = accPLoc (\p=:{pr_idi}->((pr_idi.pr_info,pr_idi.pr_trig),p)) ps

getInterText :: !*(PSt *General) -> (!(Id,Id,[Id]),!*PSt *General)
getInterText ps = accPLoc (\p=:{pr_idi}->((pr_idi.pr_text1,pr_idi.pr_text2,pr_idi.pr_text3),p)) ps

getTargets :: !*(PSt *General) -> (![Target],!*PSt *General)
getTargets ps = accPLoc (\p=:{pm_targets}->(pm_targets,p)) ps

setTargets :: ![Target] !*(PSt *General) -> *PSt *General
setTargets ts ps = appPLoc (\p->{p & pm_targets = ts}) ps

getCurrentTarget :: !*(PSt *General) -> (!Int,!*PSt *General)
getCurrentTarget ps = accPLoc (\p=:{pm_curtarg}->(pm_curtarg,p)) ps

setCurrentTarget :: !Int !*(PSt *General) -> *PSt *General
setCurrentTarget tg ps
	= appPLoc (\p->{p & pm_curtarg = tg}) ps

getCurrentPaths :: !*(PSt *General) -> (!(List Pathname),!*PSt *General)
getCurrentPaths ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_path,ps)

getCurrentDlibs :: !*(PSt *General) -> (!(List String),!*PSt *General)
getCurrentDlibs ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_libs,ps)

getCurrentSlibs :: !*(PSt *General) -> (!(List String),!*PSt *General)
getCurrentSlibs ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_stat,ps)

getCurrentObjts :: !*(PSt *General) -> (!(List String),!*PSt *General)
getCurrentObjts ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_objs,ps)

getCurrentComp :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentComp ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_comp,ps)

getCurrentCgen :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentCgen ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_cgen,ps)

getCurrentLink :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentLink ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_link,ps)

getCurrentDynl :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentDynl ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_dynl,ps)

getCurrentVers :: !*(PSt *General) -> (!Int,!*PSt *General)
getCurrentVers ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_vers,ps)

getCurrent64BitProcessor :: !*(PSt *General) -> (!Bool,!*PSt *General)
getCurrent64BitProcessor ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.env_64_bit_processor,ps)

getCurrentRedc :: !*(PSt *General) -> (!Bool,!*PSt *General)
getCurrentRedc ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_redc,ps)

getCurrentProc :: !*(PSt *General) -> (!Processor,!*PSt *General)
getCurrentProc ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_proc,ps)

getCurrentMeth :: !*(PSt *General) -> (!CompileMethod,!*PSt *General)
getCurrentMeth ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_meth,ps)

instance Editor General
where
	setEditorState es gen = {gen & ed_stat = es}
	getEditorState gen=:{ed_stat} = (ed_stat,gen)

instance Clipper General
where
	getClipInfo gen=:{ed_clip} = (ed_clip,gen)
	setClipInfo ci gen = {gen & ed_clip = ci}

instance Typer General
where
	getTypeWinInfo gen=:{tw_info} = (tw_info,gen)
	setTypeWinInfo ti gen = {gen & tw_info = ti}

//--

getPrintSetup  :: !*(PSt *General) -> (!PrintSetup,!*PSt *General)
getPrintSetup ps=:{ls={print_setup=PrintSetup print_setup}}
	= (print_setup,ps);
getPrintSetup ps=:{ls={print_setup=NoPrintSetup}}
	# (default_setup,ps) = defaultPrintSetup ps
	= (default_setup,{ps & ls.print_setup = PrintSetup default_setup});

setPrintSetup :: !PrintSetup !*(PSt *General) -> *PSt *General
setPrintSetup s ps = {ps & ls.print_setup = PrintSetup s};

getPrefix  :: !*(PSt *General) -> (![String],!*PSt *General)
getPrefix ps = accPLoc (\p=:{prefix}->(prefix,p)) ps

setPrefix :: !String !*(PSt *General) -> *PSt *General
setPrefix s ps = appPLoc (\p=:{prefix}->{p & prefix = removeDup [s:prefix]}) ps

//-- batch build support
from StdProcess import closeProcess
from StdPStClass import class FileSystem, instance FileSystem PSt
import logfile, Platform

getInteract  :: !*(PSt *General) -> (!Bool,!*PSt *General)
getInteract ps = accPLoc (\p=:{interact}->(interact,p)) ps 

setInteract :: !Bool !*(PSt *General) -> *PSt *General
setInteract interact ps = appPLoc (\p=:{interact}->{p & interact = interact}) ps


writeLog :: !String !*(PSt *General) -> *PSt *General
writeLog message ps
	= appPLoc (\ls=:{logfile} -> {ls & logfile = writeLogfile message logfile}) ps

abortLog :: !Bool !String !*(PSt *General) -> *PSt *General
abortLog flag message ps
	# ps		= case message of
					""	-> ps
					_	-> appPLoc (\ls=:{logfile} -> {ls & logfile = writeLogfile message logfile}) ps
	# (lf,ps)	= accPLoc (\ls=:{logfile} -> (logfile,{ls & logfile = stderr})) ps
	# (ok,ps)	= closeLogfile lf ps
//	| not ok ...
	# ps = case flag of
		True	-> pAbort ps
		_		-> ps
	= closeProcess ps

//-- Console support...

import conswin

instance Consoler General
where
	getConsWinInfo gen=:{cons_info} = (cons_info,gen)
	setConsWinInfo ti gen = {gen & cons_info = ti}
