r24

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.debug = True
-      debugingOptions.debugIdentifier = '3'
+      debugingOptions.debugLevel = 3
-      debugingOptions.debugLevel = 0
-      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 = 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

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
+  //if fVerId <> '' then
-  begin
+  //begin
-    if fVerIds.IndexOf(fVerId) = -1 then
+  //  if fVerIds.IndexOf(fVerId) = -1 then
-      fVerIds.Add(fVerId);
+  //    fVerIds.Add(fVerId);
-    fVerId := '';
+  //  fVerId := '';
-  end;
+  //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;

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
+    repeat
-    begin
       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.Parameters.Add('-of' + fname {$IFDEF WINDOWS}+ '.exe'{$ENDIF});
-      dmdproc.Execute;
+    dmdproc.Execute;
-      while dmdproc.Running do if dmdproc.ExitStatus <> 0 then break;
+    repeat ProcessOutputToMsg(dmdproc, mcEditor) until not dmdproc.Running;
-    finally
+    if (dmdProc.ExitStatus = 0) then
-      ProcessOutputToMsg(dmdproc, mcEditor);
-    end;
-
-    {$IFDEF MSWINDOWS}
-    if (dmdProc.ExitStatus = 0) or (dmdProc.ExitStatus = 259) then
-    {$ELSE}
-    if dmdProc.ExitStatus = 0 then
-    {$ENDIF}
     begin
-
+      ProcessOutputToMsg(dmdproc, mcEditor);
-      fMesgWidg.addCeInf( fEditWidg.editor[edIndex].fileName
+      fMesgWidg.addCeInf(editor.fileName + ' successfully compiled', mcEditor );
-        + ' successfully compiled', mcEditor );
+      runproc.Options := [poStderrToOutPut, poUsePipes];
-
-      runproc.Options:= [poStderrToOutPut, poUsePipes];
-      {$IFDEF MSWINDOWS}
-      runproc.Executable := fname + '.exe';
       runproc.CurrentDirectory := extractFilePath(runProc.Executable);
       runproc.Parameters.Text := runArgs;
-      {$ELSE}
+      runproc.Executable := fname {$IFDEF WINDOWS}+ '.exe'{$ENDIF};
-      runproc.Executable := fname;
+      runproc.Execute;
-      {$ENDIF}
+      repeat ProcessOutputToMsg(runproc, mcEditor) until not runproc.Running;
-      try
-        runproc.Execute;
-        while runproc.Running do if runproc.ExitStatus <> 0 then break;
-        ProcessOutputToMsg(runproc, mcEditor);
-      finally
       {$IFDEF MSWINDOWS}
       DeleteFile(fname + '.exe');
       DeleteFile(fname + '.obj');
@@ -1030,16 +1021,17 @@ begin
       DeleteFile(fname);
       DeleteFile(fname + '.o');
       {$ENDIF}
-      end;
     end
-    else
+    else begin
-      fMesgWidg.addCeErr( fEditWidg.editor[edIndex].fileName
+      ProcessOutputToMsg(dmdproc, mcEditor);
-        + ' has not been compiled', 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;
-      dmdproc.Execute;
+
-      while dmdproc.Running do if dmdproc.ExitStatus <> 0 then break;
+    repeat ProcessOutputToMsg(dmdproc, mcProject) until not dmdproc.Running;
-      ProcessOutputToMsg(dmdproc, mcProject);
+    if (dmdProc.ExitStatus = 0) then
-    finally
+      fMesgWidg.addCeInf(aProject.fileName + ' successfully compiled', mcProject)
-      {$IFDEF MSWINDOWS} //  STILL_ACTIVE ambiguity
+    else
-      if (dmdProc.ExitStatus = 0) or (dmdProc.ExitStatus = 259) then
+      fMesgWidg.addCeErr(aProject.fileName + ' has not been compiled', mcProject);
-      {$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;
 
     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;
+    repeat ProcessOutputToMsg(runproc, mcProject) until not runproc.Running;
-    ProcessOutputToMsg(runproc, mcProject);
 
   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);

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;

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.
+  // continue loading: this method ensures the project compat. in case of drastic changes.
-  Skip := true;
+
-  Handled := true;
+  {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;