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

IDE: implemented renaming unit of JIT class

Browse Source 
git-svn-id: trunk@9977 -
This commit is contained in:
mattias 2006-09-25 22:11:59 +00:00
parent ca7b5913c8
commit b5bc7f1565
3 changed files with 93 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
designer/jitforms.pp
View File

@ -102,6 +102,8 @@ type
var OldCode: Pointer); // Note: RemoveMethod does not free code memory
procedure DoRenameMethod(JITClass: TClass; OldName, NewName: ShortString);
procedure DoRenameClass(JITClass: TClass; const NewName: ShortString);
procedure DoRenameUnitNameOfClass(JITClass: TClass;
const NewUnitName: ShortString);
// TReader events
procedure ReaderFindMethod(Reader: TReader; const FindMethodName: Ansistring;
var Address: Pointer; var Error: Boolean);
@ -155,6 +157,8 @@ type
const OldName, NewName: ShortString);
procedure RenameComponentClass(JITComponent: TComponent;
const NewName: ShortString);
procedure RenameComponentUnitname(JITComponent: TComponent;
const NewUnitName: ShortString);
// child components
function AddJITChildComponentFromStream(JITOwnerComponent: TComponent;
BinStream: TStream; ComponentClass: TComponentClass;
@ -203,6 +207,11 @@ function ClassMethodTableAsString(AClass: TClass): string;
function ClassTypeInfoAsString(AClass: TClass): string;
function ClassFieldTableAsString(AClass: TClass): string;
function CalculateTypeDataSize(PropInfoCount: integer): integer;
function CalculateTypeInfoSize(const AClassName: shortstring;
PropInfoCount: integer): integer;
function GetTypeDataPropCountAddr(TypeData: PTypeData): PWord;
const
DefaultJITUnitName = 'VirtualUnitForJITClasses';
@ -492,6 +501,37 @@ begin
Result := Result+'}';
end;
function CalculateTypeDataSize(PropInfoCount: integer): integer;
begin
Result := SizeOf(TTypeData) + 2; // TTypeData + one word for new prop count
// Actually the size depends on the UnitName. But SizeOf(TTypeData) already
// uses the maximum size of the shortstring.
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
if Result and (SizeOf(Pointer) - 1) <> 0 then
Inc(Result, SizeOf(Pointer)); // a few bytes too much, but at least enough
{$endif}
inc(Result,PropInfoCount*SizeOf(TPropInfo));
end;
function GetTypeDataPropCountAddr(TypeData: PTypeData): PWord;
begin
Result:=PWord(@(TypeData^.UnitName)+Length(TypeData^.UnitName)+1);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
Result := Align(Result, SizeOf(Pointer));
{$endif}
end;
function CalculateTypeInfoSize(const AClassName: shortstring;
PropInfoCount: integer): integer;
begin
Result := SizeOf(TTypeKind) + 1 + length(AClassName)
+ CalculateTypeDataSize(PropInfoCount);
{$warnings off}
if SizeOf(TTypeKind)<>1 then
raise Exception.Create('CalculateTypeInfoSize SizeOf(TTypeInfo^.Kind)<>1');
{$warnings on}
end;
//------------------------------------------------------------------------------
@ -830,6 +870,22 @@ begin
DoRenameClass(JITComponent.ClassType,NewName);
end;
procedure TJITComponentList.RenameComponentUnitname(JITComponent: TComponent;
const NewUnitName: ShortString);
begin
{$IFDEF VerboseJITForms}
writeln('TJITComponentList.RenameComponentUnitname ',JITComponent.Name,':',JITComponent.Name,' New=',NewUnitName);
{$ENDIF}
if JITComponent=nil then
raise Exception.Create('TJITComponentList.RenameComponentUnitname JITComponent=nil');
if IndexOf(JITComponent)<0 then
raise Exception.Create('TJITComponentList.RenameComponentUnitname JITComponent.ClassName='+
JITComponent.ClassName);
if (NewUnitName='') or (not IsValidIdent(NewUnitName)) then
raise Exception.Create('TJITComponentList.RenameComponentUnitname invalid name: "'+NewUnitName+'"');
DoRenameUnitNameOfClass(JITComponent.ClassType,NewUnitName);
end;
function TJITComponentList.AddJITChildComponentFromStream(
JITOwnerComponent: TComponent; BinStream: TStream;
ComponentClass: TComponentClass; ParentControl: TWinControl): TComponent;
@ -941,7 +997,6 @@ var
NewTypeInfo: PTypeInfo;
NewTypeData: PTypeData;
TypeInfoSize: Integer;
TypeDataSize: Integer;
AddedPropCount: PWord;
vmtSize: Integer;
vmtTailSize: Integer;
@ -988,16 +1043,7 @@ begin
NewFieldTable^.ClassTable:=NewClassTable;
// set vmtTypeInfo
TypeDataSize := SizeOf(TTypeData) + 2; // TTypeData + one word for new prop count
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
if TypeDataSize and (SizeOf(Pointer) - 1) <> 0
then Inc(TypeDataSize, SizeOf(Pointer)); // a few bytes to much, but atleast enough
{$endif}
TypeInfoSize := SizeOf(TTypeKind) + 1 + length(NewClassName) + TypeDataSize;
{$warnings off}
if SizeOf(TTypeKind)<>1 then
raise Exception.Create('CreateNewClass SizeOf(TTypeInfo^.Kind)<>1');
{$warnings on}
TypeInfoSize := CalculateTypeInfoSize(NewClassName,0);
GetMem(NewTypeInfo,TypeInfoSize);
FillChar(NewTypeInfo^,TypeInfoSize,0);
Pointer(Pointer(NewVMT+vmtTypeInfo)^):=NewTypeInfo;
@ -1015,10 +1061,7 @@ begin
NewTypeData^.ParentInfo:=ParentClass.ClassInfo;
NewTypeData^.PropCount:=GetTypeData(NewTypeData^.ParentInfo)^.PropCount;
NewTypeData^.UnitName:=NewUnitName;
AddedPropCount:=PWord(@(NewTypeData^.UnitName)+Length(NewTypeData^.UnitName)+1);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
AddedPropCount := Align(AddedPropCount, SizeOf(Pointer));
{$endif}
AddedPropCount:=GetTypeDataPropCountAddr(NewTypeData);
AddedPropCount^:=0;
// copy the standard methods
@ -1194,6 +1237,25 @@ begin
PShortString((Pointer(JITClass)+vmtClassName)^)^:=NewName;
end;
procedure TJITComponentList.DoRenameUnitNameOfClass(JITClass: TClass;
const NewUnitName: ShortString);
var
TypeInfo: PTypeInfo;
TypeData: PTypeData;
OldPropCount: Word;
begin
TypeInfo:=PTypeInfo(JITClass.ClassInfo);
if TypeInfo=nil then
RaiseException('TJITComponentList.DoRenameUnitNameOfClass');
TypeData:=GetTypeData(TypeInfo);
//DebugLn(['TJITComponentList.DoRenameUnitNameOfClass Old=',TypeData^.UnitName,' New=',NewUnitName]);
OldPropCount:=GetTypeDataPropCountAddr(TypeData)^;
if OldPropCount<>0 then
RaiseGDBException('TJITComponentList.DoRenameUnitNameOfClass TODO: move properties and realloc mem');
TypeData^.UnitName:=NewUnitName;
GetTypeDataPropCountAddr(TypeData)^:=OldPropCount;
end;
//------------------------------------------------------------------------------
{

13
ide/customformeditor.pp
View File

@ -169,6 +169,8 @@ each control that's dropped onto the form
function CreateNonControlForm(LookupRoot: TComponent): TNonControlDesignerForm;
procedure RenameJITComponent(AComponent: TComponent;
const NewName: shortstring);
procedure RenameJITComponentUnitname(AComponent: TComponent;
const NewUnitName: shortstring);
procedure UpdateDesignerFormName(AComponent: TComponent);
function CreateNewJITMethod(AComponent: TComponent;
const AMethodName: shortstring): TMethod;
@ -1104,6 +1106,17 @@ begin
JITComponentList.RenameComponentClass(AComponent,NewName);
end;
procedure TCustomFormEditor.RenameJITComponentUnitname(AComponent: TComponent;
const NewUnitName: shortstring);
var
JITComponentList: TJITComponentList;
begin
JITComponentList:=FindJITList(AComponent);
if JITComponentList=nil then
RaiseException('TCustomFormEditor.RenameJITComponent');
JITComponentList.RenameComponentUnitname(AComponent,NewUnitName);
end;
procedure TCustomFormEditor.UpdateDesignerFormName(AComponent: TComponent);
var
ANonControlForm: TNonControlDesignerForm;

4
ide/main.pp
View File

@ -3963,7 +3963,6 @@ begin
Result:=mrOk;
end;
end else begin
if EnvironmentOptions.CharcaseFileAction = ccfaAutoRename then
NewFileName:=ExtractFilePath(NewFilename)+lowercase(FileWithoutPath);
end;
@ -4437,11 +4436,14 @@ begin
CodeToolBoss.SaveBufferAs(ResourceCode,NewResFilename,ResourceCode);
if ResourceCode<>nil then
AnUnitInfo.ResourceFileName:=ResourceCode.Filename;
if (AnUnitInfo.Component<>nil) then
FormEditor1.RenameJITComponentUnitname(AnUnitInfo.Component,NewUnitName);
{$IFDEF IDE_DEBUG}
writeln('TMainIDE.DoRenameUnit C ',ResourceCode<>nil);
writeln(' NewResFilePath="',NewResFilePath,'" NewResFilename="',NewResFilename,'"');
if ResourceCode<>nil then writeln('*** ResourceFileName ',ResourceCode.Filename);
if AnUnitInfo.Component<>nil then writeln('*** AnUnitInfo.Component ',dbgsName(AnUnitInfo.Component),' ClassUnitname=',GetClassUnitName(AnUnitInfo.Component.ClassType));
{$ENDIF}
end else begin
NewResFilename:='';