Induct into CVS

BatchBuild.prj

+Version: 1.4
+Global
+	Built:	True
+	Target:	Object IO
+	Exec:	{Project}\BatchBuild.exe
+	CodeGen
+		CheckStacks:	False
+		CheckIndexes:	True
+		TargetProcessor:	CurrentProcessor
+	Application
+		HeapSize:	4194304
+		StackSize:	102400
+		ExtraMemory:	81920
+		IntialHeapSize:	204800
+		HeapSizeMultiplier:	4096
+		ShowExecutionTime:	False
+		ShowGC:	False
+		ShowStackSize:	False
+		MarkingCollector:	False
+		StandardRuntimeEnv:	True
+		Profile
+			Memory:	False
+			MemoryMinimumHeapSize:	0
+			Time:	True
+			Stack:	True
+		Output
+			Output:	NoConsole
+			Font:	Courier
+			FontSize:	9
+			WriteStdErr:	True
+	Link
+		LinkMethod:	Static
+		GenerateRelocations:	False
+		GenerateLinkMap:	False
+		LinkResources:	False
+		ResourceSource:	
+		GenerateDLL:	False
+		ExportedNames:	
+	Paths
+		Path:	{Project}
+		Path:	{Project}\BatchBuild
+		Path:	{Application}\Directory
+		Path:	{Application}\ArgEnvWindows
+		Path:	{Application}\SetReturnCode
+		Path:	{Project}\Pm
+		Path:	{Project}\Util
+		Path:	{Project}\Win
+		Path:	{Project}\Interfaces\LinkerInterface
+	Precompile:	
+	Postlink:	
+MainModule
+	Name:	BatchBuild
+	Dir:	{Project}\BatchBuild
+	Compiler
+		NeverMemoryProfile:	False
+		NeverTimeProfile:	False
+		StrictnessAnalysis:	True
+		ListTypes:	StrictExportTypes
+		ListAttributes:	True
+		Warnings:	True
+		Verbose:	True
+		ReadableABC:	False
+		ReuseUniqueNodes:	True
+	Dcl
+		WindowPosition
+			X:	192
+			Y:	-3
+			SizeX:	800
+			SizeY:	560
+	DclOpen:	False
+	Icl
+		WindowPosition
+			X:	105
+			Y:	4
+			SizeX:	878
+			SizeY:	621
+	IclOpen:	False
+	LastModified:	No 0 0 0 0 0 0

BatchBuild/BatchBuild.icl

+module BatchBuild
+
+import StdEnv, StdIO
+import ArgEnv
+import PmDriver
+import PmProject
+import IdeState
+import UtilIO
+import PmEnvironment, logfile, set_return_code
+
+Start world
+	# (startup,world)			= accFiles GetFullApplicationPath world
+	# envspath					= applicationpath EnvsFileName
+	# (envs,world)				= openEnvironments startup envspath world
+//	| not ok					= wAbort ("Unable to read environments\n") world
+	| not path_ok				= wAbort ("BatchBuild\nUse as: 'BatchBuild projectname.prj'\n") world
+	# ((proj,ok,err),world)		= accFiles (ReadProjectFile proj_path startup) world
+	| not ok || err <> ""		= wAbort ("BatchBuild failed while opening project: "+++.err+++."\n") world
+	# (ok,logfile,world)		= openLogfile proj_path world
+	| not ok					= wAbort ("BatchBuild failed while opening logfile.\n") world
+	# (id1,world)				= openId world
+	# (id2,world)				= openId world
+	# iniGeneral				= initGeneral True default_compiler_options startup proj_path proj envs logfile id1 id2
+	#! world					= startIO NDI iniGeneral pinit [ProcessClose closeProcess] world
+	= finish world
+where
+	commandline					= getCommandLine
+	args						= [arg \\ arg <-: commandline]
+	default_compiler_options	= DefaultCompilerOptions
+	(path_ok,proj_path)			= case args of
+				[_,prj]	-> (True,GetLongPathName prj)
+				_		-> (False, "")
+
+pinit ps
+	#! ps = BringProjectUptoDate False cleanup ps
+	= ps
+where
+	cleanup exepath bool1 bool2 ps
+		= abortLog False "" ps
+
+wAbort message world
+//	# (console,world) = stdio world
+//	# console = console <<< message
+//	# (_,world) = fclose console world
+	# stderr		= fwrites message stderr
+	# (ok,world)	= fclose stderr world
+	# world			= set_return_code_world (-1) world
+	= finish world
+
+//finish :: !*World -> String
+//finish _ = ""
+finish w = w
\ No newline at end of file

BatchBuild/IdeState.dcl

+definition module IdeState
+
+import StdPSt, StdId, StdPictureDef
+import StdPathname
+import UtilStrictLists
+from PmAbcMagic import ABCCache
+from PmProject import Project
+import PmCompilerOptions
+import typewin
+import PmEnvironment
+from PmFileInfo import FileInfoCache
+
+:: *General
+
+initGeneral :: !Bool !CompilerOptions !String !String !Project ![Target] !*File !Id !Id -> *General
+
+instance Typer General
+
+:: Prefs =
+	{ be_verbose			:: !Bool
+	, compopts				:: !CompilerOptions
+	, edwinfont				:: !FontDef
+	, edwintabs				:: !(Int,Bool,Bool,Bool,Bool)
+	, number_of_processes	:: !Int
+	}
+
+:: ErrPrefs
+:: SrcPrefs
+:: NewlinePrefs
+
+getPrefs :: !*(PSt *General) -> (Prefs,*PSt *General)
+setPrefs :: Prefs !*(PSt *General) -> *PSt *General
+
+getProject :: !*(PSt *General) -> (Project,*PSt *General)
+setProject :: !Project !*(PSt *General) -> *PSt *General
+
+getABCCache :: !*(PSt *General) -> *(!*ABCCache,!*PSt *General)
+setABCCache :: !*ABCCache !*(PSt *General) -> *PSt *General
+
+getFICache :: !*(PSt *General) -> (FileInfoCache,*PSt *General)
+setFICache :: !FileInfoCache !*(PSt *General) -> *PSt *General
+
+getPath :: !*(PSt *General) -> (!Pathname,!*PSt *General)
+setPath :: !Pathname !*(PSt *General) -> !*PSt *General
+
+getStup :: !*(PSt *General) -> (!Pathname,!*PSt *General)
+getInterrupt :: !*(PSt *General) -> (!(Id,Id),!*PSt *General)
+//getKeyMapping
+
+getTargets :: !*(PSt *General) -> (![Target],!*PSt *General)
+setTargets :: ![Target] !*(PSt *General) -> !*PSt *General
+getCurrentTarget :: !*(PSt *General) -> (!Int,!*PSt *General)
+setCurrentTarget :: !Int !*(PSt *General) -> !*PSt *General
+getCurrentPaths :: !*(PSt *General) -> (!(List Pathname),!*PSt *General)
+getCurrentDlibs :: !*(PSt *General) -> (!(List String),!*PSt *General)
+getCurrentSlibs :: !*(PSt *General) -> (!(List String),!*PSt *General)
+getCurrentObjts :: !*(PSt *General) -> (!(List String),!*PSt *General)
+getCurrentComp :: !*(PSt *General) -> (!String,!*PSt *General)
+getCurrentCgen :: !*(PSt *General) -> (!String,!*PSt *General)
+getCurrentLink :: !*(PSt *General) -> (!String,!*PSt *General)
+getCurrentVers :: !*(PSt *General) -> (!Int,!*PSt *General)
+getCurrentMeth :: !*(PSt *General) -> (!CompileMethod,!*PSt *General)
+
+writeLog :: !String !*(PSt *General) -> !*PSt *General
+abortLog :: !Bool !String !*(PSt *General) -> !*PSt *General

BatchBuild/IdeState.icl

+implementation module IdeState
+
+import StdPSt, StdId, StdPictureDef, StdMisc, StdList, StdProcess, StdPStClass
+import StdPathname
+import UtilStrictLists
+from PmAbcMagic import ABCCache, AC_Init
+from PmProject import Project, PR_GetTarget
+import PmCompilerOptions
+import typewin
+import PmEnvironment
+import logfile
+import set_return_code
+//import PmDriver
+import PmFileInfo
+
+:: *General =
+	{ prefs			:: !Prefs
+	, project		:: !Project
+	, cache			:: !*(Maybe !*ABCCache)
+	, fi_cache		:: !(Maybe FileInfoCache)
+	, pr_path		:: !Pathname			// proj_path
+	, stup			:: !Pathname			// appl_path
+	, pm_targets	:: ![Target]
+	, pm_curtarg	:: !Int
+	, logfile		:: !*File
+	, int_ids		:: !(!Id,!Id)
+	}
+
+initGeneral :: !Bool !CompilerOptions !String !String !Project ![Target] !*File !Id !Id-> *General
+initGeneral be_verb comp_opts application_path project_path project targets logfile id1 id2
+	| isNothing target_index	= abort ("Unable to find project environment in available environments.\n")
+	=
+	{ prefs			= prefs
+	, project		= project
+	, cache			= Just AC_Init
+	, fi_cache		= Just FI_EmptyCache
+	, pr_path		= project_path
+	, stup			= application_path
+	, pm_targets	= targets
+	, pm_curtarg	= fromJust target_index
+	, logfile		= logfile
+	, int_ids		= (id1,id2)
+	}
+where
+	prefs =
+		{ be_verbose			= be_verb
+		, compopts				= comp_opts
+		, edwinfont				= NonProportionalFontDef
+		, edwintabs				= (4,True,False,True,True)
+		, number_of_processes	= 1
+		}
+	target_name	= PR_GetTarget project
+	target_index = findIndex 0 target_name targets
+
+	findIndex x name [] = Nothing
+	findIndex x name [t=:{target_name=n}:ns]
+		| n == name = Just x
+		= findIndex (inc x) name ns
+	
+instance Typer General
+where
+	getTypeWinInfo gen = (dummy_twi,gen)
+	setTypeWinInfo twi gen = gen
+
+:: Prefs =
+	{ be_verbose			:: !Bool
+	, compopts				:: !CompilerOptions
+	, edwinfont				:: !FontDef
+	, edwintabs				:: !(Int,Bool,Bool,Bool,Bool)	// tabsize, autotab, showtabs, showlinenos, showsyncol
+	, number_of_processes	:: !Int
+	}
+
+:: ErrPrefs		= ErrPrefs
+:: SrcPrefs		= SrcPrefs
+:: NewlinePrefs	= NwlPrefs
+
+getPrefs :: !*(PSt *General) -> (Prefs,*PSt *General)
+getPrefs ps = ps!ls.prefs
+
+setPrefs :: Prefs !*(PSt *General) -> *PSt *General
+setPrefs prefs ps = {ps & ls.prefs = prefs}
+
+getProject :: !*(PSt *General) -> (Project,*PSt *General)
+getProject ps = ps!ls.project
+
+setProject :: !Project !*(PSt *General) -> *PSt *General
+setProject project ps = {ps & ls.project = project}
+
+getABCCache :: !*(PSt *General) -> *(!*ABCCache,!*PSt *General)
+getABCCache ps = accPLoc (\p=:{cache = Just cache}->(cache,{p & cache = Nothing})) ps
+
+setABCCache :: !*ABCCache !*(PSt *General) -> *PSt *General
+setABCCache cache ps = {ps & ls.cache = Just cache}
+
+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
+
+getPath :: !*(PSt *General) -> (!Pathname,!*PSt *General)
+getPath ps = ps!ls.pr_path
+
+setPath :: !Pathname !*(PSt *General) -> !*PSt *General
+setPath path ps = {ps & ls.pr_path = path}
+
+getStup :: !*(PSt *General) -> (!Pathname,!*PSt *General)
+getStup ps = ps!ls.stup
+
+//-- NOT YET IMPLEMENTED....
+
+getInterrupt :: !*(PSt *General) -> (!(Id,Id),!*PSt *General)
+getInterrupt ps = accPLoc (\p=:{int_ids}->(int_ids,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)
+
+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)
+
+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)
+
+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	-> set_return_code_pst (-1) ps
+		_		-> ps
+	= closeProcess ps
+

BatchBuild/PmDialogues.dcl

+definition module PmDialogues
+
+import StdPSt, StdPathname, UtilStrictLists
+
+doPathsDialog :: !String !Pathname !Pathname (!List Pathname) ((!List Pathname) (PSt .l) -> (PSt .l)) (PSt .l) -> (PSt .l)

BatchBuild/PmDialogues.icl

+implementation module PmDialogues
+
+import StdPSt, StdPathname, UtilStrictLists
+
+doPathsDialog :: !String !Pathname !Pathname (!List Pathname) ((!List Pathname) (PSt .l) -> (PSt .l)) (PSt .l) -> (PSt .l)
+doPathsDialog _ _ _ _ f ps = ps

BatchBuild/errwin.dcl

+definition module errwin
+
+import StdString
+
+import StdPSt, IdeState
+
+updateErrorWindow :: !([String]) !*(PSt *General) -> *PSt *General;
+ew_safe_close			:: !*(PSt *General) -> *PSt *General

BatchBuild/errwin.icl

+implementation module errwin
+
+import StdString, StdList, StdFunc
+import StdPSt, IdeState
+
+updateErrorWindow :: !([String]) !*(PSt *General) -> *PSt *General;
+updateErrorWindow s ps = seq (map writeLog s) ps
+
+ew_safe_close :: !*(PSt *General) -> *PSt *General
+ew_safe_close ps = ps

BatchBuild/interrupt.dcl

+definition module interrupt
+
+import StdId, StdPSt, IdeState
+
+StartIntr :: !(!Id,Id) .a (.Bool -> .(.a -> .(*(PSt .b) -> *(.a,*(PSt .b))))) !*(PSt .b) -> *(PSt .b)
+StopIntr :: !(.a,!Id) !*(PSt .b) -> *(PSt .b)
+ContIntr :: !(.a,!Id) !*(PSt .b) -> *(PSt .b)

BatchBuild/interrupt.icl

+implementation module interrupt
+
+import StdId, StdPSt, StdTimer
+//import PmDriver
+import IdeState
+
+//import StdDebug
+trace_n m f :== f
+
+StartIntr :: !(!Id,Id) .a (.Bool -> .(.a -> .(*(PSt .b) -> *(.a,*(PSt .b))))) !*(PSt .b) -> *(PSt .b)
+StartIntr (dialogId,interruptId) ls callback ps
+	# (err,ps)	= openTimer ls timerdef` ps
+	= trace_n ("Start: "+++toString err) ps
+where
+	timerdef`		= Timer 0
+						NilLS
+						[ TimerId interruptId
+						, TimerSelectState Able
+						, TimerFunction (TriggerNoIntr interruptId)
+						]
+	TriggerNoIntr interruptId noi (ls,ps)
+		= trace_n "trigger" callback False ls ps
+
+StopIntr :: !(.a,!Id) !*(PSt .b) -> *(PSt .b)
+StopIntr (dialogId,interruptId) ps
+	= trace_n "Stop" appPIO (closeTimer interruptId) ps
+
+ContIntr :: !(.a,!Id) !*(PSt .b) -> *(PSt .b)
+ContIntr (dialogId,interruptId) ps
+	= trace_n "Cont" appPIO (enableTimer interruptId) ps

BatchBuild/logfile.dcl

+definition module logfile
+
+import StdString, StdFile
+
+openLogfile		:: !String !*f -> (!Bool,!*File,!*f)	| FileSystem f
+closeLogfile	:: !*File !*f -> (!Bool,!*f)	| FileSystem f
+writeLogfile	:: !String !*File -> !*File

BatchBuild/logfile.icl

+implementation module logfile
+
+import StdFile, StdPathname, StdBool
+
+openLogfile :: !String !*f -> (!Bool,!*File,!*f)	| FileSystem f
+openLogfile prj_name env
+	# log_name = RemoveSuffix prj_name +++. ".log"
+	= fopen log_name FWriteText env
+
+closeLogfile :: !*File !*f -> (!Bool,!*f)	| FileSystem f
+closeLogfile file env
+	# (ok1,file)	= ferror file
+	# (ok2,env)		= fclose file env
+	= (ok1 && ok2,env)
+
+writeLogfile :: !String !*File -> !*File
+writeLogfile s file = fwrites (s+++."\n") file

BatchBuild/messwin.dcl

+definition module messwin
+
+import StdString, StdPSt
+from IdeState import General
+
+:: Info
+	= Level1 String
+	| Level2 String
+	| Level3 [String]
+
+showInfo	:: !.Info !*(PSt General) -> !*PSt General
+closeInfo	:: !*(PSt General) -> !*PSt General

BatchBuild/messwin.icl

+implementation module messwin
+
+import StdString, StdPSt, StdBool, StdList, StdFunc
+from IdeState import General, writeLog
+
+:: Info
+	= Level1 String
+	| Level2 String
+	| Level3 [String]
+
+showInfo :: !.Info !*(PSt General) -> !*PSt General
+showInfo info  ps
+	= case info of
+		(Level1 s)	-> writeLog s ps
+		(Level2 s)	-> writeLog s ps
+		(Level3 s)	-> seq (map writeLog s) ps
+
+closeInfo :: !*(PSt General) -> !*PSt General