From f0080cc3f4ccd0760017dc9b79f23fc20ee14cdd Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Thu, 24 Jul 2014 07:32:32 +0200 Subject: [PATCH] r24 --- lazproj/test/coeditproj/test.coedit | 39 ++------- src/ce_dmdwrap.pas | 50 ++---------- src/ce_main.pas | 119 +++++++++++++--------------- src/ce_messages.pas | 8 +- src/ce_project.pas | 31 +++++++- 5 files changed, 102 insertions(+), 145 deletions(-) diff --git a/lazproj/test/coeditproj/test.coedit b/lazproj/test/coeditproj/test.coedit index 8c56682a..fe87bb92 100644 --- a/lazproj/test/coeditproj/test.coedit +++ b/lazproj/test/coeditproj/test.coedit @@ -3,7 +3,6 @@ object _1: TCEProject item name = 'default' documentationOptions.generateDocumentation = True - documentationOptions.generateJSON = False documentationOptions.DocumentationDirectory = '..\doc' debugingOptions.debug = True debugingOptions.debugIdentifiers.Strings = ( @@ -11,24 +10,9 @@ object _1: TCEProject 'b' ) debugingOptions.debugLevel = 2 - debugingOptions.addDInformations = False - debugingOptions.addCInformations = False - debugingOptions.generateMapFile = False - messagesOptions.depreciationHandling = warning - messagesOptions.verbose = False - messagesOptions.warnings = True messagesOptions.additionalWarnings = True - messagesOptions.tlsInformations = False - messagesOptions.quiet = False - outputOptions.targetKind = auto - outputOptions.binaryKind = executable - outputOptions.inlining = False outputOptions.noBoundsCheck = False outputOptions.boundsCheck = onAlways - outputOptions.optimizations = False - outputOptions.generateStackFrame = False - outputOptions.addMain = False - outputOptions.release = False outputOptions.unittest = True outputOptions.versionIdentifiers.Strings = ( 'revision_1' @@ -46,31 +30,18 @@ object _1: TCEProject item name = 'alternative' documentationOptions.generateDocumentation = True - documentationOptions.generateJSON = False documentationOptions.DocumentationDirectory = '..\doc' - debugingOptions.debug = False - debugingOptions.debugIdentifier = '3' - debugingOptions.debugLevel = 0 - debugingOptions.addDInformations = False - debugingOptions.addCInformations = False - debugingOptions.generateMapFile = False - messagesOptions.depreciationHandling = warning - messagesOptions.verbose = False - messagesOptions.warnings = True + debugingOptions.debug = True + debugingOptions.debugLevel = 3 messagesOptions.additionalWarnings = True - messagesOptions.tlsInformations = False - messagesOptions.quiet = False - outputOptions.targetKind = auto - outputOptions.binaryKind = executable outputOptions.inlining = True outputOptions.noBoundsCheck = True outputOptions.boundsCheck = onAlways outputOptions.optimizations = True - outputOptions.generateStackFrame = False - outputOptions.addMain = False - outputOptions.release = False outputOptions.unittest = True - outputOptions.versionIdentifier = 'revision_1' + outputOptions.versionIdentifiers.Strings = ( + 'revision_2' + ) pathsOptions.outputFilename = '..\output\main.exe' preBuildProcess.options = [] preBuildProcess.showWindow = swoNone diff --git a/src/ce_dmdwrap.pas b/src/ce_dmdwrap.pas index 26298a95..27afc347 100644 --- a/src/ce_dmdwrap.pas +++ b/src/ce_dmdwrap.pas @@ -118,7 +118,6 @@ type fTrgKind: TTargetSystem; fBinKind: TBinaryKind; fUt: boolean; - fVerId: string; fVerIds: TStringList; fInline: boolean; fBoundsCheck: TBoundCheckKind; @@ -132,7 +131,6 @@ type procedure depPatch; procedure setAllInst(const aValue: boolean); procedure setUt(const aValue: boolean); - procedure setVerId(const aValue: string); procedure setTrgKind(const aValue: TTargetSystem); procedure setBinKind(const aValue: TBinaryKind); procedure setInline(const aValue: boolean); @@ -155,7 +153,6 @@ type property addMain: boolean read fMain write setMain default false; property release: boolean read fRelease write setRelease default false; property unittest: boolean read fUt write setUt default false; - property versionIdentifier: string read fVerId write setVerId; // TODO-ccleaning:remove on beta1 property versionIdentifiers: TStringList read fVerIds write setVerIds; property generateAllTmpCode: boolean read fAllInst write setAllInst default false; property addStackStompCode: boolean read fStackStomp write setStackStomp default false; @@ -172,17 +169,14 @@ type TDebugOpts = class(TOptsGroup) private fDbg: boolean; - fDbgIdent: string; fDbgD: boolean; fDbgC: boolean; fMap: boolean; fDbgIdents: TStringList; fDbgLevel: Integer; fForceDbgBool: boolean; - procedure depPatch; procedure updateForceDbgBool; procedure setDbg(const aValue: boolean); - procedure setDbgIdent(const aValue: string); procedure setDbgD(const aValue: boolean); procedure setDbgC(const aValue: boolean); procedure setMap(const aValue: boolean); @@ -190,7 +184,6 @@ type procedure setDbgIdents(const aValue: TStringList); published property debug: boolean read fDbg write setDbg default false; - property debugIdentifier: string read fDbgIdent write setDbgIdent; // TODO-ccleaning:remove on beta1 property debugIdentifiers: TStringList read fDbgIdents write setDbgIdents; property debugLevel: Integer read fDbgLevel write setDbgLevel default 0; property addDInformations: boolean read fDbgD write setDbgD default false; @@ -533,12 +526,12 @@ end; procedure TOutputOpts.depPatch; begin // patch deprecated fields - if fVerId <> '' then - begin - if fVerIds.IndexOf(fVerId) = -1 then - fVerIds.Add(fVerId); - fVerId := ''; - end; + //if fVerId <> '' then + //begin + // if fVerIds.IndexOf(fVerId) = -1 then + // fVerIds.Add(fVerId); + // fVerId := ''; + //end; end; procedure TOutputOpts.getOpts(const aList: TStrings); @@ -588,7 +581,7 @@ begin fBinKind := src.fBinKind; fTrgKind := src.fTrgKind; fUt := src.fUt; - fVerId := src.fVerId; + //fVerId := src.fVerId; fVerIds.Assign(src.fVerIds); fInline := src.fInline; fNoBounds := src.fNoBounds; @@ -618,13 +611,6 @@ begin doChanged; end; -procedure TOutputOpts.setVerId(const aValue: string); -begin - if fVerId = aValue then exit; - fVerId := aValue; - doChanged; -end; - procedure TOutputOpts.setVerIds(const aValue: TStringList); begin fVerIds.Assign(aValue); @@ -716,22 +702,10 @@ begin inherited; end; -procedure TDebugOpts.depPatch; -begin - // patch deprecated field - if fDbgIdent <> '' then - begin - if fDbgIdents.IndexOf(fDbgIdent) = -1 then - fDbgIdents.Add(fDbgIdent); - fDbgIdent := ''; - end; -end; - procedure TDebugOpts.getOpts(const aList: TStrings); var idt: string; begin - depPatch; if fDbg then aList.Add('-debug'); if fDbgLevel <> 0 then aList.Add('-debug=' + intToStr(fDbgLevel)); for idt in fDbgIdents do @@ -749,14 +723,11 @@ begin begin src := TDebugOpts(aValue); fDbg := src.fDbg; - fDbgIdent := src.fDbgIdent; fDbgIdents.Assign(src.fDbgIdents); fDbgLevel := src.fDbgLevel; fDbgD := src.fDbgD; fDbgC := src.fDbgC; fMap := src.fMap; - // - depPatch; end else inherited; end; @@ -779,13 +750,6 @@ begin doChanged; end; -procedure TDebugOpts.setDbgIdent(const aValue: string); -begin - if fDbgIdent = aValue then exit; - fDbgIdent := aValue; - doChanged; -end; - procedure TDebugOpts.setDbgD(const aValue: boolean); begin if fDbgD = aValue then exit; diff --git a/src/ce_main.pas b/src/ce_main.pas index d3a2943d..fa69ad91 100644 --- a/src/ce_main.pas +++ b/src/ce_main.pas @@ -795,7 +795,7 @@ begin then exit; // for i := 0 to fWidgList.Count-1 do - fWidgList.widget[i].docClose(fEditWidg.editor[fEditWidg.editorIndex]); + fWidgList.widget[i].docClose(fEditWidg.currentEditor); // fEditWidg.removeEditor(fEditWidg.editorIndex); end; @@ -933,28 +933,31 @@ var begin If not (poUsePipes in aProcess.Options) then exit; // + readCnt := 0; ioBuffSz := aProcess.PipeBufferSize; str := TMemorystream.Create; lns := TStringList.Create; readSz := 0; try - while true do - begin + repeat str.SetSize(readSz + ioBuffSz); readCnt := aProcess.Output.Read((str.Memory + readSz)^, ioBuffSz); - if readCnt = 0 then break; Inc(readSz, readCnt); - end; + until readCnt = 0; Str.SetSize(readSz); lns.LoadFromStream(Str); for msg in lns do begin - fMesgWidg.addMessage(msg, aCtxt); dt := newMessageData; dt^.ctxt := aCtxt; + dt^.project := fProject; dt^.position := getLineFromDmdMessage(msg); dt^.editor := getFileFromDmdMessage(msg); if dt^.editor = nil then - dt^.editor := EditWidget.currentEditor; + dt^.editor := EditWidget.currentEditor + else + dt^.ctxt := mcEditor; + fMesgWidg.addMessage(msg, dt); + application.ProcessMessages; end; finally str.Free; @@ -966,6 +969,7 @@ end; // TODO-cfeature: input handling procedure TCEMainForm.compileAndRunFile(const edIndex: NativeInt; const runArgs: string = ''); var + editor: TCESynMemo; dmdproc: TProcess; runproc: TProcess; fname, temppath, olddir: string; @@ -973,56 +977,43 @@ begin olddir := ''; dmdproc := TProcess.Create(nil); runproc := TProcess.Create(nil); + editor := fEditWidg.editor[edIndex]; getDir(0, olddir); try - fMesgWidg.addCeInf( 'compiling ' + fEditWidg.editor[edIndex].fileName, mcEditor ); + fMesgWidg.ClearMessages(mcEditor); + fMesgWidg.addCeInf('compiling ' + editor.fileName, mcEditor); temppath := GetTempDir(false); chDir(temppath); {$IFDEF DEBUG}{$WARNINGS OFF}{$HINTS OFF}{$ENDIF} - fname := temppath + 'temp_' + uniqueObjStr(dmdProc); + fname := temppath + 'temp_' + uniqueObjStr(editor); {$IFDEF DEBUG}{$WARNINGS ON}{$HINTS ON}{$ENDIF} - fEditWidg.editor[edIndex].Lines.SaveToFile(fname + '.d'); + if fileExists(editor.fileName) then editor.save + else editor.saveToFile(fname + '.d'); + fname := editor.fileName[1..length(editor.fileName) - length(extractFileExt(editor.fileName))]; {$IFDEF RELEASE} dmdProc.ShowWindow := swoHIDE; {$ENDIF} dmdproc.Options := [poStdErrToOutput, poUsePipes]; dmdproc.Executable := DCompiler; - dmdproc.Parameters.Add(fname + '.d'); + dmdproc.Parameters.Add(editor.fileName); dmdproc.Parameters.Add('-w'); dmdproc.Parameters.Add('-wi'); - try - dmdproc.Execute; - while dmdproc.Running do if dmdproc.ExitStatus <> 0 then break; - finally - ProcessOutputToMsg(dmdproc, mcEditor); - end; - - {$IFDEF MSWINDOWS} - if (dmdProc.ExitStatus = 0) or (dmdProc.ExitStatus = 259) then - {$ELSE} - if dmdProc.ExitStatus = 0 then - {$ENDIF} + dmdproc.Parameters.Add('-of' + fname {$IFDEF WINDOWS}+ '.exe'{$ENDIF}); + dmdproc.Execute; + repeat ProcessOutputToMsg(dmdproc, mcEditor) until not dmdproc.Running; + if (dmdProc.ExitStatus = 0) then begin - - fMesgWidg.addCeInf( fEditWidg.editor[edIndex].fileName - + ' successfully compiled', mcEditor ); - - runproc.Options:= [poStderrToOutPut, poUsePipes]; - {$IFDEF MSWINDOWS} - runproc.Executable := fname + '.exe'; + ProcessOutputToMsg(dmdproc, mcEditor); + fMesgWidg.addCeInf(editor.fileName + ' successfully compiled', mcEditor ); + runproc.Options := [poStderrToOutPut, poUsePipes]; runproc.CurrentDirectory := extractFilePath(runProc.Executable); runproc.Parameters.Text := runArgs; - {$ELSE} - runproc.Executable := fname; - {$ENDIF} - try - runproc.Execute; - while runproc.Running do if runproc.ExitStatus <> 0 then break; - ProcessOutputToMsg(runproc, mcEditor); - finally + runproc.Executable := fname {$IFDEF WINDOWS}+ '.exe'{$ENDIF}; + runproc.Execute; + repeat ProcessOutputToMsg(runproc, mcEditor) until not runproc.Running; {$IFDEF MSWINDOWS} DeleteFile(fname + '.exe'); DeleteFile(fname + '.obj'); @@ -1030,16 +1021,17 @@ begin DeleteFile(fname); DeleteFile(fname + '.o'); {$ENDIF} - end; end - else - fMesgWidg.addCeErr( fEditWidg.editor[edIndex].fileName - + ' has not been compiled', mcEditor ); + else begin + ProcessOutputToMsg(dmdproc, mcEditor); + fMesgWidg.addCeErr(editor.fileName + ' has not been compiled', mcEditor ); + end; finally dmdproc.Free; runproc.Free; - DeleteFile(fname + '.d'); + if extractFilePath(editor.fileName) = GetTempDir(false) then + DeleteFile(editor.fileName); chDir(olddir); end; end; @@ -1086,7 +1078,6 @@ begin getDir(0, olddir); try - fMesgWidg.addCeInf( 'compiling ' + aProject.fileName, mcProject); application.ProcessMessages; @@ -1096,26 +1087,16 @@ begin {$IFDEF RELEASE} dmdProc.ShowWindow := swoHIDE; {$ENDIF} - dmdproc.Options := [{$IFDEF WINDOWS}poNewConsole,{$ENDIF} poStdErrToOutput, poUsePipes]; - + dmdproc.Options := [poStdErrToOutput, poUsePipes]; dmdproc.Executable := DCompiler; aProject.getOpts(dmdproc.Parameters); - try - dmdproc.Execute; - while dmdproc.Running do if dmdproc.ExitStatus <> 0 then break; - ProcessOutputToMsg(dmdproc, mcProject); - finally - {$IFDEF MSWINDOWS} // STILL_ACTIVE ambiguity - if (dmdProc.ExitStatus = 0) or (dmdProc.ExitStatus = 259) then - {$ELSE} - if dmdProc.ExitStatus = 0 then - {$ENDIF} - fMesgWidg.addCeInf( aProject.fileName - + ' successfully compiled', mcProject) - else - fMesgWidg.addCeErr( aProject.fileName - + ' has not been compiled', mcProject); - end; + dmdproc.Execute; + + repeat ProcessOutputToMsg(dmdproc, mcProject) until not dmdproc.Running; + if (dmdProc.ExitStatus = 0) then + fMesgWidg.addCeInf(aProject.fileName + ' successfully compiled', mcProject) + else + fMesgWidg.addCeErr(aProject.fileName + ' has not been compiled', mcProject); with fProject.currentConfiguration do begin @@ -1176,12 +1157,18 @@ begin exit; end; + // If poWaitonExit and if there are a lot of output then Coedit hangs. + if poWaitonExit in runproc.Options then + begin + runproc.Options := runproc.Options - [poStderrToOutPut, poUsePipes]; + runproc.Options := runproc.Options + [poNewConsole]; + end; + runproc.Executable := procname; if runproc.CurrentDirectory = '' then runproc.CurrentDirectory := extractFilePath(runproc.Executable); runproc.Execute; - while runproc.Running do if runproc.ExitStatus <> 0 then break; - ProcessOutputToMsg(runproc, mcProject); + repeat ProcessOutputToMsg(runproc, mcProject) until not runproc.Running; finally runproc.Free; @@ -1549,6 +1536,10 @@ begin CEMainForm.Top := fTop; CEMainForm.Width := fWidth; CEMainForm.Height := fHeight; + if fLeft < 0 then fLeft := 0; + if fTop < 0 then fTop := 0; + if fWidth < 800 then fWidth := 800; + if fHeight < 600 then fWidth := 600; // CEMainForm.fFileMru.Assign(fFileMru); CEMainForm.fProjMru.Assign(fProjMru); diff --git a/src/ce_messages.pas b/src/ce_messages.pas index b912692c..5b2ab065 100644 --- a/src/ce_messages.pas +++ b/src/ce_messages.pas @@ -253,7 +253,8 @@ end; procedure TCEMessagesWidget.projClose(const aProject: TCEProject); begin - if fProj = aProject then ClearMessages(mcProject); + if fProj = aProject then + ClearMessages(mcProject); fProj := nil; filterMessages; end; @@ -274,6 +275,8 @@ end; procedure TCEMessagesWidget.docClose(const aDoc: TCESynMemo); begin + if aDoc <> fDoc then exit; + ClearMessages(mcEditor); fDoc := nil; filterMessages; end; @@ -524,6 +527,7 @@ function getFileFromDmdMessage(const aMessage: string): TCESynMemo; var i: NativeInt; ident: string; + ext: string; begin ident := ''; i := 0; @@ -535,6 +539,8 @@ begin if aMessage[i] = '(' then begin if not fileExists(ident) then exit; + ext := extractFileExt(ident); + if not (ext = '.d') or (ext = '.di') then exit; CEMainForm.openFile(ident); result := CEMainForm.EditWidget.currentEditor; end; diff --git a/src/ce_project.pas b/src/ce_project.pas index 25b10c7c..b224a0f8 100644 --- a/src/ce_project.pas +++ b/src/ce_project.pas @@ -274,10 +274,35 @@ end; procedure TCEProject.readerPropNoFound(Reader: TReader; Instance: TPersistent; var PropName: string; IsPath: boolean; var Handled, Skip: Boolean); +var + idt: string; + curr: TCompilerConfiguration; begin - // continue loading: this method grants the project compat. in case of drastic changes. - Skip := true; - Handled := true; + // continue loading: this method ensures the project compat. in case of drastic changes. + + {curr := self.configuration[OptionsCollection.Count-1]; + if PropName = 'debugIdentifier' then + begin + idt := Reader.ReadUnicodeString; // next prop starts one char too late + if curr.debugingOptions.debugIdentifiers.IndexOf(idt) = -1 then + curr.debugingOptions.debugIdentifiers.Add(idt); + Skip := true; + Handled := true; + end + else if PropName = 'versionIdentifier' then + begin + idt := Reader.ReadString; // next prop starts one char too late + if curr.outputOptions.versionIdentifiers.IndexOf(idt) = -1 then + curr.outputOptions.versionIdentifiers.Add(idt); + Skip := true; + Handled := true; + exit; + end + else} + begin + Skip := true; + Handled := false; + end; end; procedure TCEProject.readerError(Reader: TReader; const Message: string;