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
from PmCleanSystem import QuitCleanCompiler
import Platform, IdePlatform
import PmDriver
import ArgEnv
import logfile, set_return_code
trace_n _ f :== f
//--
......@@ -90,9 +94,12 @@ Start world
# emptyFindInfo = { fi_find = [], fi_repl = [], fi_ic = False, fi_wa = True
, fi_bw = False, fi_mw = False, fi_re=False
}
# (interact, force_update, proj_path, logfile, world)
= batchOptions world
#! (iniClip,pub,world) = iniGeneral
prefs
stup
interact logfile
mTargetId
eTargetId
lbId
......@@ -121,7 +128,10 @@ Start world
mEditId mEdUndoId iniClip iniTargets mTargetId
eTargetId mProjectId mPrListId mPrRecId mFhMenId
mPhMenId ids prefs
| interact
= startIO MDI pub pini patt world
// not interact
= Batch stup force_update proj_path pub world
where
setupKeyMap world
# ((km,ok,_),world) = accFiles (ReadKeyMapFile (applicationpath "default.km")) world
......@@ -237,6 +247,20 @@ where
# ps = SetProcessIcon CleanIcon ps
= installPlatformEventHandlers ps
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}
mPrNewId mFileId mFhMenId mPhMenId quitId fhRecId phRecId prefs
......@@ -988,3 +1012,27 @@ where
}
*/
// ...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)
//---
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)
......@@ -234,5 +235,15 @@ setPrintSetup :: !PrintSetup !*(PSt *General) -> !*PSt *General
getPrefix :: !*(PSt *General) -> (![String],!*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...
......@@ -63,6 +63,8 @@ import flextextcontrol, ioutil, UtilStrictLists
,project :: !Project
, prefix :: ![String] // prefixes for add/rem prefix
, interact :: Bool
, logfile :: *File
}
getProject :: !*(PSt *General) -> (Project,*(PSt *General))
......@@ -162,11 +164,12 @@ accProject f ps
//---
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 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
# (infoId,env) = openId env
(text1Id,env) = openId env
......@@ -271,6 +274,8 @@ iniGeneral
, print_setup = default_setup
, project = PR_InitProject
, prefix = ["//\t"]
, interact = interact
, logfile = logfile
}
= (iniClip,gen,env)
......@@ -477,6 +482,35 @@ 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 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...
import conswin
instance Consoler General
......
......@@ -26,7 +26,7 @@ import morecontrols, colorpickcontrol, ioutil
from IDE import OpenModule ,Selection,Modulename,Position,ColumnNr,LineNr
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 dodebug import trace_n`
......@@ -73,8 +73,16 @@ checkWindowExistence id io
= (isMember id st,io)
updateErrorWindow :: !([String]) !*(PSt *General) -> *PSt *General;
updateErrorWindow [] ps = ps // or should we always show it?
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
#! (isOpen,ps) = accPIO (checkWindowExistence errinfo.errorId) ps
#! ps = case isOpen of
......
implementation module messwin
import StdString, StdPSt, StdList, StdWindow, StdMisc, StdBool
import StdString, StdPSt, StdList, StdWindow, StdMisc, StdBool, StdFunc
import IdeState
import errwin
......@@ -17,6 +17,17 @@ checkDialogExistence id io
showInfo :: !.Info !*(PSt General) -> !*PSt General
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
#! ((text1Id,text2Id,_),ps)
= getInterText ps
......
......@@ -415,6 +415,14 @@ where
pm_update_project_window :: !*(PSt *General) -> *PSt *General
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
# (xxId,ps) = getPWX ps
# (mmId,ps) = getPWM ps
......
......@@ -10,7 +10,7 @@ from PmPrefs import TypPrefs
iniTypeWinInfo :: !Id !Id ![Id] !TypPrefs !*a -> *(.TypeWinInfo,*a) | accScreenPicture, Ids a
// 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
isTypeWindow :: !Id !.TypeWinInfo -> Bool
......
......@@ -89,9 +89,9 @@ iniTypeWinInfo mId uId ids tprefs env
//--
updateTypeWindow :: !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
| isEmpty message
updateTypeWindow :: !Bool !String [WindowAttribute *(EditState,*(PSt *b))] ![String] !*(PSt *b) -> *PSt *b | Typer b
updateTypeWindow interact name atts message ps // fun to update type info in type window, text :: !Text
| not interact || isEmpty message
= ps
# message = [quoteString name : message]
# (twi=:{TypeWinInfo | wId,eId},ps) = getTypeWinInf ps
......
......@@ -122,6 +122,7 @@ BringProjectUptoDate force continuation ps
#! (_,ps) = ClearCompilerCache ps
#! (intr_info,ps) = getInterrupt ps
(interact,ps) = getInteract ps
ini_step = DInit force project cleanup
# ps = StartIntr intr_info ini_step step ps
= ps
......@@ -1193,8 +1194,10 @@ where
ao = PR_GetApplicationOptions project
prjpaths = PR_GetPaths project
// proc = PR_GetProcessor project
typewin :: !String -> (![String] !*(PSt *General) -> *PSt *General)
typewin mn = updateTypeWindow mn [typeWinKeyboard, typeWinMouse]
typewin :: !String ![String] !*(PSt *General) -> *PSt *General
typewin mn strings ps
# (interact, ps) = getInteract ps
= updateTypeWindow interact mn [typeWinKeyboard, typeWinMouse] strings ps
mp = ao.memoryProfiling
tp = ao.profiling
lo = PR_GetLinkOptions project
......@@ -1206,6 +1209,9 @@ where
// ProcessCompilerMsg :: !CompilerOptions !Pathname !Pathname !CompilerMsg !(List FileInfo) !.DirCache !ABCCache !Project !*(PSt *General)
// -> *(*PSt *General,List FileInfo,.DirCache,ABCCache,Project,Bool,Bool,Pathname,List String)
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
| new
# (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