Commit 4f23f9cb authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur

integrated batch build in ide

parent 71ca6921
...@@ -57,6 +57,10 @@ import targetui ...@@ -57,6 +57,10 @@ import targetui
from PmCleanSystem import QuitCleanCompiler from PmCleanSystem import QuitCleanCompiler
import Platform, IdePlatform import Platform, IdePlatform
import PmDriver
import ArgEnv
import logfile, set_return_code
trace_n _ f :== f trace_n _ f :== f
//-- //--
...@@ -90,9 +94,12 @@ Start world ...@@ -90,9 +94,12 @@ Start world
# emptyFindInfo = { fi_find = [], fi_repl = [], fi_ic = False, fi_wa = True # emptyFindInfo = { fi_find = [], fi_repl = [], fi_ic = False, fi_wa = True
, fi_bw = False, fi_mw = False, fi_re=False , fi_bw = False, fi_mw = False, fi_re=False
} }
# (interact, force_update, proj_path, logfile, world)
= batchOptions world
#! (iniClip,pub,world) = iniGeneral #! (iniClip,pub,world) = iniGeneral
prefs prefs
stup stup
interact logfile
mTargetId mTargetId
eTargetId eTargetId
lbId lbId
...@@ -121,7 +128,10 @@ Start world ...@@ -121,7 +128,10 @@ Start world
mEditId mEdUndoId iniClip iniTargets mTargetId mEditId mEdUndoId iniClip iniTargets mTargetId
eTargetId mProjectId mPrListId mPrRecId mFhMenId eTargetId mProjectId mPrListId mPrRecId mFhMenId
mPhMenId ids prefs mPhMenId ids prefs
= startIO MDI pub pini patt world | interact
= startIO MDI pub pini patt world
// not interact
= Batch stup force_update proj_path pub world
where where
setupKeyMap world setupKeyMap world
# ((km,ok,_),world) = accFiles (ReadKeyMapFile (applicationpath "default.km")) world # ((km,ok,_),world) = accFiles (ReadKeyMapFile (applicationpath "default.km")) world
...@@ -237,6 +247,20 @@ where ...@@ -237,6 +247,20 @@ where
# ps = SetProcessIcon CleanIcon ps # ps = SetProcessIcon CleanIcon ps
= installPlatformEventHandlers ps = installPlatformEventHandlers ps
ini _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ps = abort "IDE.icl: ini called with insufficient id's" ini _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ps = abort "IDE.icl: ini called with insufficient id's"
batchOptions world
= case [arg \\ arg <-: getCommandLine] of
[_, "--batch-build", prj]
-> batch False prj world
[_, "--batch-force-build", prj]
-> batch True prj world
_
-> (True, abort "force_update", abort "project file", abort "logfile", world)
where
batch force_update prj world
# (ok,logfile,world) = openLogfile prj world
| not ok
= (False, force_update, prj, logfile, wAbort ("--batch-build failed while opening logfile.\n") world)
= (False, force_update, prj, logfile, world)
fileMenu prefspath {mn_clo,mn_sva,mn_sav,mn_rev,mn_oth,mn_prt,mn_prs,mn_odm,mn_oim} fileMenu prefspath {mn_clo,mn_sva,mn_sav,mn_rev,mn_oth,mn_prt,mn_prs,mn_odm,mn_oim}
mPrNewId mFileId mFhMenId mPhMenId quitId fhRecId phRecId prefs mPrNewId mFileId mFhMenId mPhMenId quitId fhRecId phRecId prefs
...@@ -988,3 +1012,27 @@ where ...@@ -988,3 +1012,27 @@ where
} }
*/ */
// ...Wrap // ...Wrap
Batch startup force_update proj_path initialState world
# ((proj,ok,err),world) = accFiles (ReadProjectFile proj_path startup) world
| not ok || err <> ""
= wAbort ("--batch-build failed while opening project: "+++.err+++."\n") world
= startIO NDI initialState (pinit force_update proj proj_path) [ProcessClose closeProcess] world
pinit force_update proj proj_path ps
# ps = setInteract False ps
# ps = setProject proj ps
# ps = setPath proj_path ps
# ps = selectProjectTarget getTargets ps
# ps = BringProjectUptoDate force_update cleanup ps
= ps
where
cleanup exepath bool1 bool2 ps
= abortLog False "" ps
wAbort message world
# stderr = fwrites message stderr
// # (_,world) = fclose stderr world
# world = set_return_code /* _world */ (-1) world
= world
...@@ -124,6 +124,7 @@ accProject :: (!Project -> (.a,Project)) !*(PSt *General) -> (.a,*PSt *General) ...@@ -124,6 +124,7 @@ accProject :: (!Project -> (.a,Project)) !*(PSt *General) -> (.a,*PSt *General)
//--- //---
iniGeneral :: Prefs .Pathname iniGeneral :: Prefs .Pathname
Bool *File
Id Id .(ExtListBoxId *(PSt *General)) EditorState .FindInfo Id Id .(ExtListBoxId *(PSt *General)) EditorState .FindInfo
.(FindBoxInfo *(PSt *General)) Id Id TypeWinInfo ConsWinInfo .[.Target] Id Id (R2Id PLMMessage PLMReply) !*World//*env .(FindBoxInfo *(PSt *General)) Id Id TypeWinInfo ConsWinInfo .[.Target] Id Id (R2Id PLMMessage PLMReply) !*World//*env
-> *(!ClipInfo,!*General,!*World) -> *(!ClipInfo,!*General,!*World)
...@@ -234,5 +235,15 @@ setPrintSetup :: !PrintSetup !*(PSt *General) -> !*PSt *General ...@@ -234,5 +235,15 @@ setPrintSetup :: !PrintSetup !*(PSt *General) -> !*PSt *General
getPrefix :: !*(PSt *General) -> (![String],!*PSt *General) getPrefix :: !*(PSt *General) -> (![String],!*PSt *General)
setPrefix :: !String !*(PSt *General) -> !*PSt *General setPrefix :: !String !*(PSt *General) -> !*PSt *General
//-- boolean that indicates if user interaction is allowed
getInteract :: !*(PSt *General) -> (!Bool,!*PSt *General)
setInteract :: !Bool !*(PSt *General) -> !*PSt *General
//-- log functions for batch build
writeLog :: !String !*(PSt *General) -> !*PSt *General
abortLog :: !Bool !String !*(PSt *General) -> !*PSt *General
//-- Console support... //-- Console support...
...@@ -63,6 +63,8 @@ import flextextcontrol, ioutil, UtilStrictLists ...@@ -63,6 +63,8 @@ import flextextcontrol, ioutil, UtilStrictLists
,project :: !Project ,project :: !Project
, prefix :: ![String] // prefixes for add/rem prefix , prefix :: ![String] // prefixes for add/rem prefix
, interact :: Bool
, logfile :: *File
} }
getProject :: !*(PSt *General) -> (Project,*(PSt *General)) getProject :: !*(PSt *General) -> (Project,*(PSt *General))
...@@ -162,11 +164,12 @@ accProject f ps ...@@ -162,11 +164,12 @@ accProject f ps
//--- //---
iniGeneral :: Prefs .Pathname iniGeneral :: Prefs .Pathname
Bool *File
Id Id .(ExtListBoxId *(PSt *General)) EditorState .FindInfo Id Id .(ExtListBoxId *(PSt *General)) EditorState .FindInfo
.(FindBoxInfo *(PSt *General)) Id Id TypeWinInfo ConsWinInfo .[.Target] Id Id (R2Id PLMMessage PLMReply) !*World//*env .(FindBoxInfo *(PSt *General)) Id Id TypeWinInfo ConsWinInfo .[.Target] Id Id (R2Id PLMMessage PLMReply) !*World//*env
-> *(!ClipInfo,!*General,!*World) -> *(!ClipInfo,!*General,!*World)
iniGeneral iniGeneral
prefs stup mTargetId eTargetId lbId initEditorState emptyFindInfo ffind prefs stup interact logfile mTargetId eTargetId lbId initEditorState emptyFindInfo ffind
mEdUndoId mMdEdOptId iniTwi iniCons iniTargets mProjMenuId mProjListId mProjRecId env mEdUndoId mMdEdOptId iniTwi iniCons iniTargets mProjMenuId mProjListId mProjRecId env
# (infoId,env) = openId env # (infoId,env) = openId env
(text1Id,env) = openId env (text1Id,env) = openId env
...@@ -271,6 +274,8 @@ iniGeneral ...@@ -271,6 +274,8 @@ iniGeneral
, print_setup = default_setup , print_setup = default_setup
, project = PR_InitProject , project = PR_InitProject
, prefix = ["//\t"] , prefix = ["//\t"]
, interact = interact
, logfile = logfile
} }
= (iniClip,gen,env) = (iniClip,gen,env)
...@@ -477,6 +482,35 @@ getPrefix ps = accPLoc (\p=:{prefix}->(prefix,p)) ps ...@@ -477,6 +482,35 @@ getPrefix ps = accPLoc (\p=:{prefix}->(prefix,p)) ps
setPrefix :: !String !*(PSt *General) -> !*PSt *General setPrefix :: !String !*(PSt *General) -> !*PSt *General
setPrefix s ps = appPLoc (\p=:{prefix}->{p & prefix = removeDup [s:prefix]}) ps setPrefix s ps = appPLoc (\p=:{prefix}->{p & prefix = removeDup [s:prefix]}) ps
//-- batch build support
from StdProcess import closeProcess
from StdPStClass import FileSystem
import logfile
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 -> ps // FIXME set_return_code_pst (-1) ps
_ -> ps
= closeProcess ps
//-- Console support... //-- Console support...
import conswin import conswin
instance Consoler General instance Consoler General
......
...@@ -26,7 +26,7 @@ import morecontrols, colorpickcontrol, ioutil ...@@ -26,7 +26,7 @@ import morecontrols, colorpickcontrol, ioutil
from IDE import OpenModule ,Selection,Modulename,Position,ColumnNr,LineNr from IDE import OpenModule ,Selection,Modulename,Position,ColumnNr,LineNr
from IdeState import General, getErrInfo, setErrInfo, ErrorInfo, MenuIds, getMenuIds, ErrPrefs from IdeState import General, getErrInfo, setErrInfo, ErrorInfo, MenuIds, getMenuIds, ErrPrefs
from IdeState import SearchMenuIds, PLMMessage, PLMReply, MIn, EditMenuLS from IdeState import SearchMenuIds, PLMMessage, PLMReply, MIn, EditMenuLS, getInteract, writeLog
from EdClient import lineSelection from EdClient import lineSelection
//from dodebug import trace_n` //from dodebug import trace_n`
...@@ -73,8 +73,16 @@ checkWindowExistence id io ...@@ -73,8 +73,16 @@ checkWindowExistence id io
= (isMember id st,io) = (isMember id st,io)
updateErrorWindow :: !([String]) !*(PSt *General) -> *PSt *General; updateErrorWindow :: !([String]) !*(PSt *General) -> *PSt *General;
updateErrorWindow [] ps = ps // or should we always show it?
updateErrorWindow messages ps updateErrorWindow messages ps
# (interact, ps) = getInteract ps
| not interact
= seq (map writeLog messages) ps
// interact
= updateErrorWindowInteractive messages ps
updateErrorWindowInteractive :: !([String]) !*(PSt *General) -> *PSt *General;
updateErrorWindowInteractive [] ps = ps // or should we always show it?
updateErrorWindowInteractive messages ps
#! (errinfo,ps) = getErrInfo ps #! (errinfo,ps) = getErrInfo ps
#! (isOpen,ps) = accPIO (checkWindowExistence errinfo.errorId) ps #! (isOpen,ps) = accPIO (checkWindowExistence errinfo.errorId) ps
#! ps = case isOpen of #! ps = case isOpen of
......
implementation module messwin implementation module messwin
import StdString, StdPSt, StdList, StdWindow, StdMisc, StdBool import StdString, StdPSt, StdList, StdWindow, StdMisc, StdBool, StdFunc
import IdeState import IdeState
import errwin import errwin
...@@ -17,6 +17,17 @@ checkDialogExistence id io ...@@ -17,6 +17,17 @@ checkDialogExistence id io
showInfo :: !.Info !*(PSt General) -> !*PSt General showInfo :: !.Info !*(PSt General) -> !*PSt General
showInfo info ps showInfo info ps
# (interact, ps) = getInteract ps
| not interact
= case info of
(Level1 s) -> writeLog s ps
(Level2 s) -> writeLog s ps
(Level3 s) -> seq (map writeLog s) ps
// interact
= showInfoInteractive info ps
showInfoInteractive :: !.Info !*(PSt General) -> *PSt General
showInfoInteractive info ps
#! ((dlogId,_),ps) = getInterrupt ps #! ((dlogId,_),ps) = getInterrupt ps
#! ((text1Id,text2Id,_),ps) #! ((text1Id,text2Id,_),ps)
= getInterText ps = getInterText ps
......
...@@ -415,6 +415,14 @@ where ...@@ -415,6 +415,14 @@ where
pm_update_project_window :: !*(PSt *General) -> *PSt *General pm_update_project_window :: !*(PSt *General) -> *PSt *General
pm_update_project_window ps pm_update_project_window ps
# (interact, ps) = getInteract ps
| not interact
= ps
// interact
= pm_update_project_window_interactive ps
pm_update_project_window_interactive :: !*(PSt *General) -> *PSt *General
pm_update_project_window_interactive ps
# (lbId,ps) = getPWI ps # (lbId,ps) = getPWI ps
# (xxId,ps) = getPWX ps # (xxId,ps) = getPWX ps
# (mmId,ps) = getPWM ps # (mmId,ps) = getPWM ps
......
...@@ -10,7 +10,7 @@ from PmPrefs import TypPrefs ...@@ -10,7 +10,7 @@ from PmPrefs import TypPrefs
iniTypeWinInfo :: !Id !Id ![Id] !TypPrefs !*a -> *(.TypeWinInfo,*a) | accScreenPicture, Ids a iniTypeWinInfo :: !Id !Id ![Id] !TypPrefs !*a -> *(.TypeWinInfo,*a) | accScreenPicture, Ids a
// initialise type window info // initialise type window info
updateTypeWindow :: !String [WindowAttribute *(EditState,*(PSt *b))] ![String] !*(PSt *b) -> *PSt *b | Typer b updateTypeWindow :: !Bool !String [WindowAttribute *(EditState,*(PSt *b))] ![String] !*(PSt *b) -> *PSt *b | Typer b
// add content to the types window // add content to the types window
isTypeWindow :: !Id !.TypeWinInfo -> Bool isTypeWindow :: !Id !.TypeWinInfo -> Bool
......
...@@ -89,9 +89,9 @@ iniTypeWinInfo mId uId ids tprefs env ...@@ -89,9 +89,9 @@ iniTypeWinInfo mId uId ids tprefs env
//-- //--
updateTypeWindow :: !String [WindowAttribute *(EditState,*(PSt *b))] ![String] !*(PSt *b) -> *PSt *b | Typer b updateTypeWindow :: !Bool !String [WindowAttribute *(EditState,*(PSt *b))] ![String] !*(PSt *b) -> *PSt *b | Typer b
updateTypeWindow name atts message ps // fun to update type info in type window, text :: !Text updateTypeWindow interact name atts message ps // fun to update type info in type window, text :: !Text
| isEmpty message | not interact || isEmpty message
= ps = ps
# message = [quoteString name : message] # message = [quoteString name : message]
# (twi=:{TypeWinInfo | wId,eId},ps) = getTypeWinInf ps # (twi=:{TypeWinInfo | wId,eId},ps) = getTypeWinInf ps
......
...@@ -122,6 +122,7 @@ BringProjectUptoDate force continuation ps ...@@ -122,6 +122,7 @@ BringProjectUptoDate force continuation ps
#! (_,ps) = ClearCompilerCache ps #! (_,ps) = ClearCompilerCache ps
#! (intr_info,ps) = getInterrupt ps #! (intr_info,ps) = getInterrupt ps
(interact,ps) = getInteract ps
ini_step = DInit force project cleanup ini_step = DInit force project cleanup
# ps = StartIntr intr_info ini_step step ps # ps = StartIntr intr_info ini_step step ps
= ps = ps
...@@ -1193,8 +1194,10 @@ where ...@@ -1193,8 +1194,10 @@ where
ao = PR_GetApplicationOptions project ao = PR_GetApplicationOptions project
prjpaths = PR_GetPaths project prjpaths = PR_GetPaths project
// proc = PR_GetProcessor project // proc = PR_GetProcessor project
typewin :: !String -> (![String] !*(PSt *General) -> *PSt *General) typewin :: !String ![String] !*(PSt *General) -> *PSt *General
typewin mn = updateTypeWindow mn [typeWinKeyboard, typeWinMouse] typewin mn strings ps
# (interact, ps) = getInteract ps
= updateTypeWindow interact mn [typeWinKeyboard, typeWinMouse] strings ps
mp = ao.memoryProfiling mp = ao.memoryProfiling
tp = ao.profiling tp = ao.profiling
lo = PR_GetLinkOptions project lo = PR_GetLinkOptions project
...@@ -1206,6 +1209,9 @@ where ...@@ -1206,6 +1209,9 @@ where
// ProcessCompilerMsg :: !CompilerOptions !Pathname !Pathname !CompilerMsg !(List FileInfo) !.DirCache !ABCCache !Project !*(PSt *General) // ProcessCompilerMsg :: !CompilerOptions !Pathname !Pathname !CompilerMsg !(List FileInfo) !.DirCache !ABCCache !Project !*(PSt *General)
// -> *(*PSt *General,List FileInfo,.DirCache,ABCCache,Project,Bool,Bool,Pathname,List String) // -> *(*PSt *General,List FileInfo,.DirCache,ABCCache,Project,Bool,Bool,Pathname,List String)
ProcessCompilerMsg compileOrCheckSyntax _ path abcpath (Patherror pathname) fileinfo dircache abccache project ps ProcessCompilerMsg compileOrCheckSyntax _ path abcpath (Patherror pathname) fileinfo dircache abccache project ps
# (interact, ps) = getInteract ps
| not interact
= (ps,fileinfo,dircache,abccache,project,False,False,abcpath,Nil)
# (ps,project,new) = NewPathsDialog (GetModuleName path) pathname project ps # (ps,project,new) = NewPathsDialog (GetModuleName path) pathname project ps
| new | new
# (syspaths,ps) = getCurrentPaths ps # (syspaths,ps) = getCurrentPaths ps
......
definition module set_return_code;
//1.3
from StdString import String;
//3.1
:: *UniqueWorld :== World;
set_return_code :: !Int !UniqueWorld -> UniqueWorld;
// void set_return_code (int return_code);
implementation module set_return_code;
import code from "set_return_code.obj";
import StdString;
:: *UniqueWorld :== World;
set_return_code :: !Int !UniqueWorld -> UniqueWorld;
set_return_code a0 a1 = code
{
ccall set_return_code "I:V:A"
fill_a 0 1
pop_a 1
}
// void set_return_code (int return_code);
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment