paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 23:19:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: fixed save lrs to test dir

Browse Source 
git-svn-id: trunk@1621 -
This commit is contained in:
lazarus 2002-04-21 06:53:55 +00:00
parent 6c8804716a
commit 25b2c52fe6
4 changed files with 84 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
components/codetools/codetoolmanager.pas
View File

@ -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
View File

@ -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

29
lcl/include/customgroupbox.inc
View File

@ -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
} }

5
lcl/stdctrls.pp
View File

@ -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