paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 22:41:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented virtual temporary ct files

Browse Source 
git-svn-id: trunk@5747 -
This commit is contained in:
mattias 2004-08-07 07:03:29 +00:00
parent 56f1575595
commit ebb787e8f5
9 changed files with 131 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
components/codetools/codecache.pas
View File

@ -46,6 +46,7 @@ type
TCodeBuffer = class(TSourceLog)
private
FFilename: string;
FReferenceCount: integer;
FScanner: TLinkScanner;
FOnSetScanner: TNotifyEvent;
FOnSetFilename: TNotifyEvent;
@ -64,17 +65,15 @@ type
procedure SetIsDeleted(const NewValue: boolean);
procedure MakeFileDateValid;
public
property Scanner: TLinkScanner read FScanner write SetScanner;
property LastIncludedByFile: string
read GetLastIncludedByFile write FLastIncludedByFile;
property Filename: string read FFilename write SetFilename;
constructor Create;
destructor Destroy; override;
function ConsistencyCheck: integer; // 0 = ok
procedure WriteDebugReport;
function LoadFromFile(const AFilename: string): boolean; override;
function Reload: boolean; // = LoadFromFile(Filename)
function Revert: boolean; // ignore changes and reload source
function SaveToFile(const AFilename: string): boolean; override;
function Save: boolean;
property LoadDateValid: boolean read FLoadDateValid;
property LoadDate: longint read FLoadDate;
function FileDateOnDisk: longint;
function FileNeedsUpdate: boolean;
function FileOnDiskNeedsUpdate: boolean;
@ -83,17 +82,23 @@ type
function AutoRevertFromDisk: boolean;
procedure LockAutoDiskRevert;
procedure UnlockAutoDiskRevert;
property OnSetScanner: TNotifyEvent read FOnSetScanner write FOnSetScanner;
property OnSetFilename: TNotifyEvent read FOnSetFilename write FOnSetFilename;
property IsVirtual: boolean read FIsVirtual;
property IsDeleted: boolean read FIsDeleted write SetIsDeleted;
procedure IncrementRefCount;
procedure ReleaseRefCount;
public
property CodeCache: TCodeCache read FCodeCache write FCodeCache;
property Filename: string read FFilename write SetFilename;
property GlobalWriteLockStepOnLastLoad: integer
read FGlobalWriteLockStepOnLastLoad write FGlobalWriteLockStepOnLastLoad;
property CodeCache: TCodeCache read FCodeCache write FCodeCache;
constructor Create;
destructor Destroy; override;
function ConsistencyCheck: integer; // 0 = ok
procedure WriteDebugReport;
property IsDeleted: boolean read FIsDeleted write SetIsDeleted;
property IsVirtual: boolean read FIsVirtual;
property LastIncludedByFile: string read GetLastIncludedByFile
write FLastIncludedByFile;
property LoadDate: longint read FLoadDate;
property LoadDateValid: boolean read FLoadDateValid;
property OnSetFilename: TNotifyEvent read FOnSetFilename write FOnSetFilename;
property OnSetScanner: TNotifyEvent read FOnSetScanner write FOnSetScanner;
property Scanner: TLinkScanner read FScanner write SetScanner;
property ReferenceCount: integer read FReferenceCount;
end;
TIncludedByLink = class
@ -109,6 +114,7 @@ type
private
FItems: TAVLTree; // tree of TCodeBuffer
FIncludeLinks: TAVLTree; // tree of TIncludedByLink
FDestroying: boolean;
FExpirationTimeInDays: integer;
FGlobalWriteLockIsSet: boolean;
FGlobalWriteLockStep: integer;
@ -140,6 +146,7 @@ type
function FindFile(AFilename: string): TCodeBuffer;
function LastIncludedByFile(const IncludeFilename: string): string;
function LoadFile(const AFilename: string): TCodeBuffer;
procedure RemoveCodeBuffer(Buffer: TCodeBuffer);
function LoadIncludeLinksFromFile(const AFilename: string): boolean;
function LoadIncludeLinksFromXML(XMLConfig: TXMLConfig;
const XMLPath: string): boolean;
@ -218,6 +225,7 @@ end;
destructor TCodeCache.Destroy;
begin
FDestroying:=true;
Clear;
FIncludeLinks.FreeAndClear;
FIncludeLinks.Free;
@ -287,6 +295,12 @@ begin
end;
end;
procedure TCodeCache.RemoveCodeBuffer(Buffer: TCodeBuffer);
begin
if not FDestroying then
FItems.Remove(Buffer);
end;
function TCodeCache.CreateFile(const AFilename: string): TCodeBuffer;
begin
Result:=FindFile(AFileName);
@ -296,7 +310,7 @@ begin
Result:=TCodeBuffer.Create;
Result.FileName:=AFileName;
FItems.Add(Result);
Result.FCodeCache:=Self;
Result.FCodeCache:=Self;// must be called after FileName:=
Result.LastIncludedByFile:=FindIncludeLink(Result.Filename);
end;
end;
@ -725,6 +739,7 @@ end;
destructor TCodeBuffer.Destroy;
begin
if Scanner<>nil then Scanner.Free;
if FCodeCache<>nil then FCodeCache.RemoveCodeBuffer(Self);
inherited Destroy;
end;
@ -889,6 +904,18 @@ begin
if FAutoDiskRevertLock>0 then dec(FAutoDiskRevertLock);
end;
procedure TCodeBuffer.IncrementRefCount;
begin
inc(FReferenceCount);
end;
procedure TCodeBuffer.ReleaseRefCount;
begin
if FReferenceCount=0 then
raise Exception.Create('TCodeBuffer.ReleaseRefCount');
dec(FReferenceCount);
end;
function TCodeBuffer.ConsistencyCheck: integer; // 0 = ok
begin
if FScanner<>nil then begin

22
components/codetools/codetoolmanager.pas
View File

@ -152,6 +152,8 @@ type
function LoadFile(const ExpandedFilename: string;
UpdateFromDisk, Revert: boolean): TCodeBuffer;
function CreateFile(const AFilename: string): TCodeBuffer;
function CreateTempFile(const AFilename: string): TCodeBuffer;
procedure ReleaseTempFile(Buffer: TCodeBuffer);
function SaveBufferAs(OldBuffer: TCodeBuffer;const ExpandedFilename: string;
var NewBuffer: TCodeBuffer): boolean;
function FilenameHasSourceExt(const AFilename: string): boolean;
@ -578,6 +580,26 @@ begin
{$ENDIF}
end;
function TCodeToolManager.CreateTempFile(const AFilename: string): TCodeBuffer;
var
i: Integer;
TempFilename: string;
begin
i:=1;
repeat
TempFilename:=VirtualTempDir+PathDelim+IntToStr(i)+PathDelim+AFilename;
Result:=FindFile(TempFilename);
if (Result<>nil) and (Result.ReferenceCount=0) then exit;
until Result=nil;
Result:=SourceCache.CreateFile(TempFilename);
Result.IncrementRefCount;
end;
procedure TCodeToolManager.ReleaseTempFile(Buffer: TCodeBuffer);
begin
Buffer.ReleaseRefCount;
end;
function TCodeToolManager.SaveBufferAs(OldBuffer: TCodeBuffer;
const ExpandedFilename: string; var NewBuffer: TCodeBuffer): boolean;
begin

3
components/codetools/definetemplates.pas
View File

@ -78,8 +78,9 @@ const
DCUSrcPathMacroName = ExternalMacroStart+'DCUSrcPath';
CompiledSrcPathMacroName = ExternalMacroStart+'CompiledSrcPath';
// virtual directory
// virtual directories
VirtualDirectory='VIRTUALDIRECTORY';
VirtualTempDir='TEMPORARYDIRECTORY';
// FPC operating systems and processor types
FPCOperatingSystemNames: array[1..19] of shortstring =(

4
designer/changeclassdialog.pas
View File

@ -37,7 +37,7 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, AVGLvlTree, PropEdits, LazarusIDEStrConsts, ComponentReg,
FormEditingIntf, LFMTrees;
FormEditingIntf, CheckLFMDlg;
type
TChangeClassDlg = class(TForm)
@ -118,7 +118,7 @@ begin
FormEditingHook.SaveSelectionToStream(ComponentStream);
// parse
// change class
// change classname
// check properties

20
ide/checklfmdlg.pas
View File

@ -79,6 +79,8 @@ type
function CheckLFMBuffer(PascalBuffer, LFMBuffer: TCodeBuffer;
const OnOutput: TOnOutputString): boolean;
function CheckLFMText(PascalBuffer: TCodeBuffer; const LFMText: string;
const OnOutput: TOnOutputString): boolean;
function ShowRepairLFMWizard(LFMBuffer: TCodeBuffer;
LFMTree: TLFMTree): boolean;
@ -120,8 +122,9 @@ var
end;
begin
Result:=CodeToolBoss.CheckLFM(PascalBuffer,LFMBuffer,nil,LFMTree);
LFMTree:=nil;
try
Result:=CodeToolBoss.CheckLFM(PascalBuffer,LFMBuffer,nil,LFMTree);
if Result then exit;
WriteLFMErrors;
Result:=ShowRepairLFMWizard(LFMBuffer,LFMTree);
@ -130,6 +133,21 @@ begin
end;
end;
function CheckLFMText(PascalBuffer: TCodeBuffer; const LFMText: string;
const OnOutput: TOnOutputString): boolean;
var
LFMBuf: TCodeBuffer;
begin
Result:=false;
LFMBuf:=CodeToolBoss.CreateTempFile('temp.lfm');
try
LFMBuf.Source:=LFMText;
Result:=CheckLFMBuffer(PascalBuffer,LFMBuf,OnOutput);
finally
CodeToolBoss.ReleaseTempFile(LFMBuf);
end;
end;
function ShowRepairLFMWizard(LFMBuffer: TCodeBuffer;
LFMTree: TLFMTree): boolean;
var

9
ide/lazarusidestrconsts.pas
View File

@ -418,6 +418,15 @@ resourcestring
+'Paths->Other Unit Files';
lisNOTECouldNotCreateDefineTemplateForFreePascal = 'NOTE: Could not create '
+'Define Template for Free Pascal Sources';
lisClassNotFound = 'Class not found';
lisClassIsNotARegisteredComponentClassUnableToPaste = 'Class %s%s%s is not '
+'a registered component class.%sUnable to paste.';
lisControlNeedsParent = 'Control needs parent';
lisTheClassIsATControlAndCanNotBePastedOntoANonContro = 'The class %s%s%s '
+'is a TControl and can not be pasted onto a non control.%sUnable to paste.';
lisConversionError = 'Conversion error';
lisUnableToConvertComponentTextIntoBinaryFormat = 'Unable to convert '
+'component text into binary format:%s%s';
lisNOTECouldNotCreateDefineTemplateForLazarusSources = 'NOTE: Could not '
+'create Define Template for Lazarus Sources';
lisInvalidExpressionHintTheMakeResourcestringFunction = 'Invalid expression.%'

22
ide/main.pp
View File

@ -8185,19 +8185,18 @@ begin
// check if component class is registered
ARegComp:=IDEComponentPalette.FindComponent(NewClassName);
if ARegComp=nil then begin
MessageDlg('Class not found',
'Class "'+NewClassName+'" is not a registered component class.'#13
+'Unable to paste.',
MessageDlg(lisClassNotFound,
Format(lisClassIsNotARegisteredComponentClassUnableToPaste, ['"',
NewClassName, '"', #13]),
mtError,[mbCancel],0);
exit;
end;
// check if there is a valid parent
if (ParentControl=nil) and ARegComp.IsTControl then begin
MessageDlg('Control needs parent',
'The class "'+NewClassName+'" is a TControl and can not be pasted '
+'onto a non control.'#13
+'Unable to paste.',
MessageDlg(lisControlNeedsParent,
Format(lisTheClassIsATControlAndCanNotBePastedOntoANonContro, ['"',
NewClassName, '"', #13]),
mtError,[mbCancel],0);
exit;
end;
@ -8209,9 +8208,9 @@ begin
ObjectTextToBinary(TxtCompStream,BinCompStream);
except
on E: Exception do begin
MessageDlg('Conversion error',
'Unable to convert component text into binary format:'#13
+E.Message,
MessageDlg(lisConversionError,
Format(lisUnableToConvertComponentTextIntoBinaryFormat, [#13,
E.Message]),
mtError,[mbCancel],0);
exit;
end;
@ -10489,6 +10488,9 @@ end.
{ =============================================================================
$Log$
Revision 1.743 2004/08/07 07:03:29 mattias
implemented virtual temporary ct files
Revision 1.742 2004/08/05 21:20:46 mattias
moved designer/abstractformeditor.pp to ideintf/formeditingintf.pas

21
ide/project.pp
View File

@ -843,6 +843,7 @@ begin
CodeToolBoss.RenameSource(fSource,NewUnitName);
end;
fUnitName:=NewUnitName;
Modified:=true;
if Project<>nil then Project.Modified:=true;
end;
end;
@ -1667,9 +1668,11 @@ begin
if AddToProjectFile and (MainUnitID>=0) and (MainUnitID<>NewIndex) then begin
// add unit to uses section
ShortUnitName:=AnUnit.UnitName;
if (ShortUnitName<>'') and (not UnitIsUsed(ShortUnitName)) then
if (ShortUnitName<>'') and (not UnitIsUsed(ShortUnitName)) then begin
CodeToolBoss.AddUnitToMainUsesSection(MainUnitInfo.Source,
ShortUnitName,'');
MainUnitInfo.Modified:=true;
end;
end;
EndUpdate;
Modified:=true;
@ -1696,12 +1699,16 @@ begin
if (MainUnitID>=0) then begin
// remove unit from uses section and from createforms in program file
if (OldUnitInfo.IsPartOfProject) then begin
if (OldUnitInfo.UnitName<>'') then
CodeToolBoss.RemoveUnitFromAllUsesSections(Units[MainUnitID].Source,
if (OldUnitInfo.UnitName<>'') then begin
CodeToolBoss.RemoveUnitFromAllUsesSections(MainUnitInfo.Source,
OldUnitInfo.UnitName);
if (OldUnitInfo.ComponentName<>'') then
CodeToolBoss.RemoveCreateFormStatement(Units[MainUnitID].Source,
MainUnitInfo.Modified:=true;
end;
if (OldUnitInfo.ComponentName<>'') then begin
CodeToolBoss.RemoveCreateFormStatement(MainUnitInfo.Source,
OldUnitInfo.ComponentName);
MainUnitInfo.Modified:=true;
end;
end;
end;
@ -2518,6 +2525,7 @@ begin
// rename unit in program uses section
CodeToolBoss.RenameUsedUnit(MainUnitInfo.Source
,OldUnitName,NewUnitName,'');
MainUnitInfo.Modified:=true;
end;
end;
end;
@ -2852,6 +2860,9 @@ end.
{
$Log$
Revision 1.156 2004/08/07 07:03:29 mattias
implemented virtual temporary ct files
Revision 1.155 2004/08/04 16:58:15 mattias
fixed setting Modified for hidden lpr file when adding CreateFormStatement

5
lcl/dbgrids.pas
View File

@ -799,7 +799,7 @@ begin
else if (FDataLink.DataSet<>nil)and FDatalink.Active then begin
F := GetDsFieldFromGridColumn(FromIndex);
if F<>nil then begin
{$IFDEF VER1_0_10}
{$IFNDEF VER1_0_10}
TProtFields(FDatalink.DataSet.Fields).SetFieldIndex( F, ToIndex - FixedCols );
{$ENDIF}
end;
@ -1770,6 +1770,9 @@ end.
{
$Log$
Revision 1.12 2004/08/07 07:03:29 mattias
implemented virtual temporary ct files
Revision 1.11 2004/08/06 06:51:15 mattias
fixed compilation for fpc 1.0.10