mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-13 15:59:38 +02:00
MG: fixed save lrs to test dir
git-svn-id: trunk@1621 -
This commit is contained in:
lazarus
parent
6c8804716a
commit
25b2c52fe6
@ -452,17 +452,10 @@ begin
|
||||
// find MainCode (= the start source, e.g. a unit/program/package source)
|
||||
Result:=Code;
|
||||
if Result=nil then exit;
|
||||
while (not FilenameHasSourceExt(Result.Filename)) do begin
|
||||
// source is no begin of unit/program/package
|
||||
// perhaps it is included by another source
|
||||
if Result.LastIncludedByFile<>'' then begin
|
||||
// source is included
|
||||
Result:=SourceCache.LoadFile(Result.LastIncludedByFile);
|
||||
if Result=nil then exit;
|
||||
end else begin
|
||||
// source was never parsed
|
||||
exit;
|
||||
end;
|
||||
// if this is an include file, find the top level source
|
||||
while (Result.LastIncludedByFile<>'') do begin
|
||||
Result:=SourceCache.LoadFile(Result.LastIncludedByFile);
|
||||
if Result=nil then exit;
|
||||
end;
|
||||
if FilenameHasSourceExt(Result.Filename) and (Result.Scanner=nil) then begin
|
||||
// create a scanner for the unit/program
|
||||
@ -1100,13 +1093,13 @@ var ResCode: TCodeBuffer;
|
||||
LinkIndex: integer;
|
||||
begin
|
||||
Result:=false;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.AddLazarusResource A ',Code.Filename,' ResourceName=',ResourceName,' ',length(ResourceData));
|
||||
{$ENDIF}
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.AddLazarusResource A ',Code.Filename,' ResourceName=',ResourceName,' ',length(ResourceData));
|
||||
{$ENDIF}
|
||||
if not InitCurCodeTool(Code) then exit;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.AddLazarusResource B ');
|
||||
{$ENDIF}
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.AddLazarusResource B ');
|
||||
{$ENDIF}
|
||||
try
|
||||
LinkIndex:=-1;
|
||||
ResCode:=FCurCodeTool.FindNextIncludeInInitialization(LinkIndex);
|
||||
@ -1124,9 +1117,9 @@ var ResCode: TCodeBuffer;
|
||||
LinkIndex: integer;
|
||||
begin
|
||||
Result:=false;
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.RemoveLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
|
||||
{$ENDIF}
|
||||
{$IFDEF CTDEBUG}
|
||||
writeln('TCodeToolManager.RemoveLazarusResource A ',Code.Filename,' ResourceName=',ResourceName);
|
||||
{$ENDIF}
|
||||
if not InitCurCodeTool(Code) then exit;
|
||||
try
|
||||
LinkIndex:=-1;
|
||||
|
||||
80
ide/main.pp
80
ide/main.pp
@ -2601,7 +2601,7 @@ var
|
||||
Driver: TAbstractObjectWriter;
|
||||
Writer:TWriter;
|
||||
ACaption, AText: string;
|
||||
CompResourceCode, LFMFilename, TestFilename: string;
|
||||
CompResourceCode, LFMFilename, TestFilename, ResTestFilename: string;
|
||||
begin
|
||||
// save lrs - lazarus resource file and lfm - lazarus form text file
|
||||
// Note: When there is a bug in the source, no resource code can be found,
|
||||
@ -2635,11 +2635,18 @@ begin
|
||||
[mbAbort, mbRetry, mbIgnore], 0);
|
||||
if Result=mrAbort then exit;
|
||||
if Result=mrIgnore then Result:=mrOk;
|
||||
FormSavingOk:=false;
|
||||
end;
|
||||
until Result<>mrRetry;
|
||||
// create lazarus form resource code
|
||||
if FormSavingOk then begin
|
||||
if ResourceCode<>nil then begin
|
||||
if (sfSaveToTestDir in Flags) then begin
|
||||
ResTestFilename:=ChangeFileExt(GetTestUnitFilename(AnUnitInfo),
|
||||
ResourceFileExt);
|
||||
ResourceCode:=CodeToolBoss.CreateFile(ResTestFilename);
|
||||
FormSavingOk:=(ResourceCode<>nil);
|
||||
end;
|
||||
if FormSavingOk then begin
|
||||
// there is no bug in the source, so the resource code should be
|
||||
// changed too
|
||||
MemStream:=TMemoryStream.Create;
|
||||
@ -2653,20 +2660,26 @@ begin
|
||||
finally
|
||||
MemStream.Free;
|
||||
end;
|
||||
{$IFDEF IDE_DEBUG}
|
||||
writeln('TMainIDE.SaveFileResources E ',CompResourceCode);
|
||||
{$ENDIF}
|
||||
end;
|
||||
if FormSavingOk then begin
|
||||
{$IFDEF IDE_DEBUG}
|
||||
writeln('TMainIDE.SaveFileResources E ',CompResourceCode);
|
||||
{$ENDIF}
|
||||
// replace lazarus form resource code
|
||||
if (not CodeToolBoss.AddLazarusResource(ResourceCode,
|
||||
'T'+AnUnitInfo.FormName,CompResourceCode)) then
|
||||
begin
|
||||
ACaption:='Resource error';
|
||||
AText:='Unable to add resource '
|
||||
+'T'+AnUnitInfo.FormName+':FORMDATA to resource file '#13
|
||||
+'"'+ResourceCode.FileName+'".'#13
|
||||
+'Probably a syntax error.';
|
||||
Result:=MessageDlg(ACaption, AText, mtError, [mbIgnore, mbAbort],0);
|
||||
if Result=mrAbort then exit;
|
||||
if not (sfSaveToTestDir in Flags) then begin
|
||||
if (not CodeToolBoss.AddLazarusResource(ResourceCode,
|
||||
'T'+AnUnitInfo.FormName,CompResourceCode)) then
|
||||
begin
|
||||
ACaption:='Resource error';
|
||||
AText:='Unable to add resource '
|
||||
+'T'+AnUnitInfo.FormName+':FORMDATA to resource file '#13
|
||||
+'"'+ResourceCode.FileName+'".'#13
|
||||
+'Probably a syntax error.';
|
||||
Result:=MessageDlg(ACaption, AText, mtError, [mbIgnore, mbAbort],0);
|
||||
if Result=mrAbort then exit;
|
||||
end;
|
||||
end else begin
|
||||
ResourceCode.Source:=CompResourceCode;
|
||||
end;
|
||||
end;
|
||||
if (not (sfSaveToTestDir in Flags)) then begin
|
||||
@ -2681,9 +2694,9 @@ writeln('TMainIDE.SaveFileResources E ',CompResourceCode);
|
||||
end;
|
||||
end;
|
||||
if LFMCode<>nil then begin
|
||||
{$IFDEF IDE_DEBUG}
|
||||
writeln('TMainIDE.SaveFileResources E2 LFM=',LFMCode.Filename);
|
||||
{$ENDIF}
|
||||
{$IFDEF IDE_DEBUG}
|
||||
writeln('TMainIDE.SaveFileResources E2 LFM=',LFMCode.Filename);
|
||||
{$ENDIF}
|
||||
repeat
|
||||
try
|
||||
// transform binary to text
|
||||
@ -2718,10 +2731,10 @@ writeln('TMainIDE.SaveFileResources E2 LFM=',LFMCode.Filename);
|
||||
BinCompStream.Free;
|
||||
end;
|
||||
end;
|
||||
{$IFDEF IDE_DEBUG}
|
||||
if ResourceCode<>nil then
|
||||
writeln('TMainIDE.SaveFileResources F ',ResourceCode.Modified);
|
||||
{$ENDIF}
|
||||
{$IFDEF IDE_DEBUG}
|
||||
if ResourceCode<>nil then
|
||||
writeln('TMainIDE.SaveFileResources F ',ResourceCode.Modified);
|
||||
{$ENDIF}
|
||||
if ResourceCode<>nil then begin
|
||||
if not (sfSaveToTestDir in Flags) then begin
|
||||
if (ResourceCode.Modified) then begin
|
||||
@ -2739,9 +2752,9 @@ if ResourceCode<>nil then
|
||||
end;
|
||||
end;
|
||||
Result:=mrOk;
|
||||
{$IFDEF IDE_DEBUG}
|
||||
writeln('TMainIDE.SaveFileResources G ',LFMCode<>nil);
|
||||
{$ENDIF}
|
||||
{$IFDEF IDE_DEBUG}
|
||||
writeln('TMainIDE.SaveFileResources G ',LFMCode<>nil);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TMainIDE.DoOpenNotExistingFile(const AFileName: string;
|
||||
@ -3292,7 +3305,7 @@ writeln('TMainIDE.DoNewEditorUnit A NewFilename=',NewFilename);
|
||||
end else begin
|
||||
FCodeLastActivated:=true;
|
||||
end;
|
||||
writeln('TMainIDE.DoNewUnit end');
|
||||
writeln('TMainIDE.DoNewUnit end');
|
||||
{$IFDEF IDE_MEM_CHECK}CheckHeap(IntToStr(GetMem_Cnt));{$ENDIF}
|
||||
end;
|
||||
|
||||
@ -3303,7 +3316,7 @@ var ActiveSrcEdit:TSourceEditor;
|
||||
TestFilename: string;
|
||||
ResourceCode, LFMCode: TCodeBuffer;
|
||||
begin
|
||||
writeln('TMainIDE.DoSaveEditorUnit A PageIndex=',PageIndex,' SaveAs=',sfSaveAs in Flags,' SaveToTestDir=',sfSaveToTestDir in Flags);
|
||||
writeln('TMainIDE.DoSaveEditorUnit A PageIndex=',PageIndex,' SaveAs=',sfSaveAs in Flags,' SaveToTestDir=',sfSaveToTestDir in Flags);
|
||||
{$IFDEF IDE_MEM_CHECK}CheckHeap(IntToStr(GetMem_Cnt));{$ENDIF}
|
||||
Result:=mrCancel;
|
||||
if ToolStatus<>itNone then begin
|
||||
@ -3378,9 +3391,9 @@ writeln('TMainIDE.DoSaveEditorUnit A PageIndex=',PageIndex,' SaveAs=',sfSaveAs i
|
||||
exit;
|
||||
end;
|
||||
|
||||
{$IFDEF IDE_DEBUG}
|
||||
writeln('*** HasResources=',ActiveUnitInfo.HasResources);
|
||||
{$ENDIF}
|
||||
{$IFDEF IDE_DEBUG}
|
||||
writeln('*** HasResources=',ActiveUnitInfo.HasResources);
|
||||
{$ENDIF}
|
||||
{$IFDEF IDE_MEM_CHECK}CheckHeap(IntToStr(GetMem_Cnt));{$ENDIF}
|
||||
// save resource file and lfm file
|
||||
if (ResourceCode<>nil) or (ActiveUnitInfo.Form<>nil) then begin
|
||||
@ -3396,7 +3409,7 @@ writeln('*** HasResources=',ActiveUnitInfo.HasResources);
|
||||
end;
|
||||
SourceNoteBook.UpdateStatusBar;
|
||||
|
||||
writeln('TMainIDE.DoSaveEditorUnit END');
|
||||
writeln('TMainIDE.DoSaveEditorUnit END');
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
@ -3408,7 +3421,7 @@ var ActiveSrcEdit: TSourceEditor;
|
||||
i:integer;
|
||||
OldDesigner: TDesigner;
|
||||
begin
|
||||
writeln('TMainIDE.DoCloseEditorUnit A PageIndex=',PageIndex);
|
||||
writeln('TMainIDE.DoCloseEditorUnit A PageIndex=',PageIndex);
|
||||
Result:=mrCancel;
|
||||
GetUnitWithPageIndex(PageIndex,ActiveSrcEdit,ActiveUnitInfo);
|
||||
if ActiveUnitInfo=nil then exit;
|
||||
@ -6222,6 +6235,9 @@ end.
|
||||
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.280 2002/04/21 06:53:52 lazarus
|
||||
MG: fixed save lrs to test dir
|
||||
|
||||
Revision 1.279 2002/04/16 08:55:04 lazarus
|
||||
MG: added path editor for compiler options
|
||||
|
||||
|
||||
@ -1,31 +1,38 @@
|
||||
// included by stdctrls.pp
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
{ function TCustomGroupBox.AdjustClientRect }
|
||||
{------------------------------------------------------------------------------}
|
||||
procedure TCustomGroupBox.AdjustClientRect(var Rect: TRect);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
// ToDo: ask the interface for the logical clientrect
|
||||
|
||||
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------}
|
||||
{ function TCustomGroupBox.Create }
|
||||
{------------------------------------------------------------------------------}
|
||||
constructor TCustomGroupBox.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create (AOwner);
|
||||
fCompStyle := csGroupBox;
|
||||
ControlStyle := ControlStyle + [csAcceptsControls];
|
||||
inherited Create (AOwner);
|
||||
fCompStyle := csGroupBox;
|
||||
ControlStyle := ControlStyle + [csAcceptsControls];
|
||||
end;
|
||||
|
||||
// included by stdctrls.pp
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2002/04/21 06:53:55 lazarus
|
||||
MG: fixed save lrs to test dir
|
||||
|
||||
Revision 1.2 2002/04/18 08:09:03 lazarus
|
||||
MG: added include comments
|
||||
|
||||
Revision 1.1 2000/07/13 10:28:25 michael
|
||||
+ Initial import
|
||||
|
||||
Revision 1.1 2000/04/02 20:49:56 lazarus
|
||||
MWE:
|
||||
Moved lazarus/lcl/*.inc files to lazarus/lcl/include
|
||||
|
||||
Revision 1.3 2000/01/02 00:25:12 lazarus
|
||||
Stoppok:
|
||||
- enhanced TCustomradiogroup & TCustomgroupbox
|
||||
|
||||
}
|
||||
|
||||
@ -114,6 +114,8 @@ type
|
||||
|
||||
|
||||
TCustomGroupBox = class (TWinControl) {class(TCustomControl) }
|
||||
protected
|
||||
procedure AdjustClientRect(var Rect: TRect); override;
|
||||
public
|
||||
constructor Create(AOwner : TComponent); Override;
|
||||
end;
|
||||
@ -581,6 +583,9 @@ end.
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.25 2002/04/21 06:53:54 lazarus
|
||||
MG: fixed save lrs to test dir
|
||||
|
||||
Revision 1.24 2002/04/18 08:09:03 lazarus
|
||||
MG: added include comments
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user