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