Commit 18653865 authored by Diederik van Arkel's avatar Diederik van Arkel

Induct into CVS

parent 3acf537b
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
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
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
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
definition module PmDialogues
import StdPSt, StdPathname, UtilStrictLists
doPathsDialog :: !String !Pathname !Pathname (!List Pathname) ((!List Pathname) (PSt .l) -> (PSt .l)) (PSt .l) -> (PSt .l)
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
definition module errwin
import StdString
import StdPSt, IdeState
updateErrorWindow :: !([String]) !*(PSt *General) -> *PSt *General;
ew_safe_close :: !*(PSt *General) -> *PSt *General
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
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)
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
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
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
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
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
closeInfo ps
= ps
definition module projwin
import StdPSt, IdeState
pm_update_project_window :: !*(PSt *General) -> *PSt *General
implementation module projwin
import StdPSt, IdeState
pm_update_project_window :: !*(PSt *General) -> *PSt *General
pm_update_project_window ps = ps
definition module typeatt
import typewin
implementation module typeatt
definition module typewin
import StdString
import StdWindowDef
import StdPSt
//import IdeState
updateTypeWindow :: !String [Int] ![String] !*(PSt *b) -> *PSt *b | Typer b
tw_safe_close :: !*(PSt *b) -> *PSt *b | Typer b
class Typer env
where
getTypeWinInfo :: !*env -> *(!TypeWinInfo, !*env)
setTypeWinInfo :: !TypeWinInfo !*env -> *env
:: TypeWinInfo
dummy_twi :: TypeWinInfo
typeWinKeyboard :: Int
typeWinMouse :: Int
implementation module typewin
import StdString
import StdWindowDef
import StdPSt
//import IdeState
updateTypeWindow :: !String [Int] ![String] !*(PSt *b) -> *PSt *b | Typer b
updateTypeWindow _ _ _ ps = ps
tw_safe_close :: !*(PSt *b) -> *PSt *b | Typer b
tw_safe_close ps = ps
class Typer env
where
getTypeWinInfo :: !*env -> *(!TypeWinInfo, !*env)
setTypeWinInfo :: !TypeWinInfo !*env -> *env
:: TypeWinInfo = TWI
dummy_twi :: TypeWinInfo
dummy_twi = TWI
typeWinKeyboard :: Int
typeWinKeyboard = 42
typeWinMouse :: Int
typeWinMouse = 7
Version: 1.4
Global
Built: True
Target: Object IO
Exec: {Project}\change_registry.exe
CodeGen
CheckStacks: False
CheckIndexes: True
TargetProcessor: CurrentProcessor
Application
HeapSize: 409600
StackSize: 102400
ExtraMemory: 81920
IntialHeapSize: 204800
HeapSizeMultiplier: 4096
ShowExecutionTime: False