paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 03:37:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 52020 #75791c984b, 52066 #e9527743c5, 52110 #217ce1a2d5 from trunk:

Browse Source 
IDE: Show methods when clicked in OI also when they are in another unit/form. Issue #25954.
........
IDE: Sort a category list in "All options" parser. Issue #29907.
........
IDE: Export/Import also package options properly. Worked only for project. Issue #27709.
........

git-svn-id: branches/fixes_1_6@52121 -
This commit is contained in:
maxim 2016-04-06 21:47:29 +00:00
parent 1458597b9f
commit 3075271a0a
6 changed files with 88 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
components/ideintf/propedits.pp
View File

@ -1165,8 +1165,8 @@ type
// methods
TPropHookCreateMethod = function(const Name: ShortString; ATypeInfo: PTypeInfo;
APersistent: TPersistent; const APropertyPath: string): TMethod of object;
TPropHookGetMethodName = function(const Method: TMethod;
CheckOwner: TObject): String of object;
TPropHookGetMethodName = function(const Method: TMethod; CheckOwner: TObject;
OrigLookupRoot: TPersistent): String of object;
TPropHookGetCompatibleMethods = procedure(InstProp: PInstProp; const Proc: TGetStrProc) of object;
TPropHookGetMethods = procedure(TypeData: PTypeData; Proc: TGetStrProc) of object;
TPropHookCompatibleMethodExists = function(const Name: String; InstProp: PInstProp;
@ -4255,6 +4255,22 @@ begin
Result := True;
end;
function IsValidPropName(const PropName: string): boolean;
var
i, len: integer;
begin
result := false;
len := length(PropName);
if len <> 0 then begin
result := PropName[1] in ['A'..'Z', 'a'..'z', '_'];
i := 1;
while (result) and (i < len) do begin
i := i + 1;
result := result and (PropName[i] in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.']);
end ;
end ;
end ;
procedure TMethodPropertyEditor.Edit;
{ If the method does not exist in current lookuproot: create it
Then jump to the source.
@ -4263,11 +4279,11 @@ procedure TMethodPropertyEditor.Edit;
the ancestor value is added. Then the IDE jumps to the new method body.
}
var
NewMethodName: shortstring;
NewMethodName: String;
begin
NewMethodName := GetValue;
//DebugLn('### TMethodPropertyEditor.Edit A OldValue=',NewMethodName);
if not IsValidIdent(NewMethodName) or PropertyHook.MethodFromAncestor(GetMethodValue) then
if not IsValidPropName(NewMethodName) or PropertyHook.MethodFromAncestor(GetMethodValue) then
begin
// the current method is from the ancestor
// -> add an override with the default name
@ -5564,7 +5580,7 @@ var
begin
i:=GetHandlerCount(htGetMethodName);
if GetNextHandlerIndex(htGetMethodName,i) then begin
Result:=TPropHookGetMethodName(FHandlers[htGetMethodName][i])(Method,PropOwner);
Result:=TPropHookGetMethodName(FHandlers[htGetMethodName][i])(Method,PropOwner,LookupRoot);
end else begin
// search the method name with the given code pointer
if Assigned(Method.Code) then begin

2
ide/compiler.pp
View File

@ -926,6 +926,7 @@ begin
fDefines := TStringList.Create;
fInvalidOptions := TStringList.Create;
fSupportedCategories := TStringList.Create;
fSupportedCategories.Sorted := True;
fGeneratedOptions := TStringList.Create;
fRootOptGroup := TCompilerOptGroup.Create(Self, Nil);
end;
@ -1050,7 +1051,6 @@ begin
else if AnsiStartsStr(Supported, Line) then
Category := AddNewCategory(Copy(Line, Length(Supported)+1, Length(Line)));
end;
fSupportedCategories.Sorted := True;
finally
sl.Free;
end;

4
ide/frames/compiler_path_options.pas
View File

@ -309,7 +309,7 @@ end;
procedure TCompilerPathOptionsFrame.DoImport(Sender: TObject);
begin
DoSaveSettings(FCompilerOpts);
if (ShowImportCompilerOptionsDialog(FDialog) = mrOK)
if (ShowImportCompilerOptionsDialog(FCompilerOpts, FDialog) = mrOK)
and Assigned(OnLoadIDEOptions) then
OnLoadIDEOptions(Self, FCompilerOpts);
end;
@ -317,7 +317,7 @@ end;
procedure TCompilerPathOptionsFrame.DoExport(Sender: TObject);
begin
DoSaveSettings(FCompilerOpts);
if (ShowExportCompilerOptionsDialog(FDialog) = mrOK)
if (ShowExportCompilerOptionsDialog(FCompilerOpts, FDialog) = mrOK)
and Assigned(OnSaveIDEOptions) then
OnSaveIDEOptions(Self, FCompilerOpts);
end;

78
ide/imexportcompileropts.pas
View File

@ -57,7 +57,7 @@ type
FFilename: string;
FParentDialog: TAbstractOptionsEditorDialog;
FExport: boolean;
procedure InitExport;
procedure InitExport(AOptions: TBaseCompilerOptions);
procedure InitImport;
procedure LoadRecentList;
//procedure SaveRecentList;
@ -72,7 +72,8 @@ type
TOptsImExport = class
private
fOwner: TImExportCompOptsDlg;
fOptions: TBaseCompilerOptions; // TProjectCompilerOptions or TPkgCompilerOptions
fImExportDlg: TImExportCompOptsDlg;
fXMLConfig: TXMLConfig;
function GetXMLPathForCompilerOptions: string;
function OpenXML(const Filename: string): TModalResult;
@ -80,12 +81,14 @@ type
function DoImport(const Filename: string): TModalResult;
function DoExportOptions(const Filename: string): TModalResult;
function DoExportBuildModes(const Filename: string): TModalResult;
constructor Create(aOwner: TImExportCompOptsDlg);
constructor Create(AOptions: TBaseCompilerOptions; aImExportDlg: TImExportCompOptsDlg);
destructor Destroy; override;
end;
function ShowImportCompilerOptionsDialog(aDialog: TAbstractOptionsEditorDialog): TModalResult;
function ShowExportCompilerOptionsDialog(aDialog: TAbstractOptionsEditorDialog): TModalResult;
function ShowImportCompilerOptionsDialog(AOptions: TBaseCompilerOptions;
aDialog: TAbstractOptionsEditorDialog): TModalResult;
function ShowExportCompilerOptionsDialog(AOptions: TBaseCompilerOptions;
aDialog: TAbstractOptionsEditorDialog): TModalResult;
implementation
@ -95,7 +98,8 @@ implementation
const
DefaultCompilerOptPath = 'CompilerOptions/';
function ShowImportCompilerOptionsDialog(aDialog: TAbstractOptionsEditorDialog): TModalResult;
function ShowImportCompilerOptionsDialog(AOptions: TBaseCompilerOptions;
aDialog: TAbstractOptionsEditorDialog): TModalResult;
var
ImExportCompOptsDlg: TImExportCompOptsDlg;
Importer: TOptsImExport;
@ -106,7 +110,7 @@ begin
ImExportCompOptsDlg.InitImport;
Result := ImExportCompOptsDlg.ShowModal;
if Result <> mrOk then Exit;
Importer := TOptsImExport.Create(ImExportCompOptsDlg);
Importer := TOptsImExport.Create(AOptions, ImExportCompOptsDlg);
try
Result := Importer.DoImport(ImExportCompOptsDlg.Filename);
finally
@ -117,7 +121,8 @@ begin
end;
end;
function ShowExportCompilerOptionsDialog(aDialog: TAbstractOptionsEditorDialog): TModalResult;
function ShowExportCompilerOptionsDialog(AOptions: TBaseCompilerOptions;
aDialog: TAbstractOptionsEditorDialog): TModalResult;
var
ImExportCompOptsDlg: TImExportCompOptsDlg;
Exporter: TOptsImExport;
@ -125,10 +130,10 @@ begin
ImExportCompOptsDlg := TImExportCompOptsDlg.Create(nil);
try
ImExportCompOptsDlg.FParentDialog := aDialog;
ImExportCompOptsDlg.InitExport;
ImExportCompOptsDlg.InitExport(AOptions);
Result := ImExportCompOptsDlg.ShowModal;
if Result <> mrOk then Exit;
Exporter := TOptsImExport.Create(ImExportCompOptsDlg);
Exporter := TOptsImExport.Create(AOptions, ImExportCompOptsDlg);
try
case ImExportCompOptsDlg.ExportRadioGroup.ItemIndex of
0: Result := Exporter.DoExportOptions(ImExportCompOptsDlg.Filename);
@ -144,10 +149,12 @@ end;
{ TOptsImExport }
constructor TOptsImExport.Create(aOwner: TImExportCompOptsDlg);
constructor TOptsImExport.Create(AOptions: TBaseCompilerOptions;
aImExportDlg: TImExportCompOptsDlg);
begin
inherited Create;
fOwner := aOwner;
fOptions := AOptions;
fImExportDlg := aImExportDlg;
end;
destructor TOptsImExport.Destroy;
@ -205,19 +212,29 @@ begin
end;
function TOptsImExport.DoImport(const Filename: string): TModalResult;
// Import options to project or package. Only projects support BuildModes.
var
Path: String;
CompOptPath: String;
begin
Result := OpenXML(Filename);
if Result <> mrOK then Exit;
Path := GetXMLPathForCompilerOptions;
if Assigned(fXMLConfig.FindNode('BuildModes',False)) then begin
Project1.BuildModes.LoadProjOptsFromXMLConfig(fXMLConfig, '');
fOwner.FParentDialog.UpdateBuildModeGUI;
ShowMessageFmt(lisSuccessfullyImportedBuildModes, [Project1.BuildModes.Count, Filename]);
CompOptPath := GetXMLPathForCompilerOptions;
if Assigned(fXMLConfig.FindNode('BuildModes',False)) then
begin // The import file has BuildModes.
if fOptions is TProjectCompilerOptions then
begin // Project options
Project1.BuildModes.LoadProjOptsFromXMLConfig(fXMLConfig, '');
fImExportDlg.FParentDialog.UpdateBuildModeGUI;
ShowMessageFmt(lisSuccessfullyImportedBuildModes, [Project1.BuildModes.Count, Filename]);
end
else begin // Package options
ShowMessage(lisImportingBuildModesNotSupported);
Result := mrAbort;
end;
end
else if Assigned(fXMLConfig.FindNode(Path,False)) then begin
Project1.CompilerOptions.LoadFromXMLConfig(fXMLConfig, Path);
else if Assigned(fXMLConfig.FindNode(CompOptPath,False)) then
begin
fOptions.LoadFromXMLConfig(fXMLConfig, CompOptPath);
ShowMessageFmt(lisSuccessfullyImportedCompilerOptions, [Filename]);
end
else
@ -225,15 +242,17 @@ begin
end;
function TOptsImExport.DoExportOptions(const Filename: string): TModalResult;
// Export options of project or package.
begin
Result := OpenXML(Filename);
if Result <> mrOK then Exit;
Project1.CompilerOptions.SaveToXMLConfig(fXMLConfig, DefaultCompilerOptPath);
fOptions.SaveToXMLConfig(fXMLConfig, DefaultCompilerOptPath);
fXMLConfig.Flush;
ShowMessageFmt(lisSuccessfullyExportedCompilerOptions, [Filename]);
end;
function TOptsImExport.DoExportBuildModes(const Filename: string): TModalResult;
// Export options of project's BuildModes. Packages don't have BuildModes.
begin
Result := OpenXML(Filename);
if Result <> mrOK then Exit;
@ -253,12 +272,11 @@ begin
// If file contains one mode -> ItemIndex:=0. If more modes -> ItemIndex:=1.
ExportRadioGroup.Visible:=False;
OpenDlg.Filter:=Format(
'%s|*.xml|'
+'%s|*.lpi|'
+'%s|*.lpk|'
+'%s|*.lps|'
+'%s|%s',
OpenDlg.Filter:=Format('%s|*.xml|'
+'%s|*.lpi|'
+'%s|*.lpk|'
+'%s|*.lps|'
+'%s|%s',
[dlgFilterXML,
dlgFilterLazarusProject,
dlgFilterLazarusPackage,
@ -275,14 +293,16 @@ begin
end;
end;
procedure TImExportCompOptsDlg.InitExport;
procedure TImExportCompOptsDlg.InitExport(AOptions: TBaseCompilerOptions);
begin
FExport:=true;
Caption:=lisIECOExportCompilerOptions;
SaveDlg.Filter:=Format('%s|*.xml|%s|%s',
[dlgFilterXML, dlgFilterAll, GetAllFilesMask]);
if Project1.BuildModes.Count <= 1 then
if not (AOptions is TProjectCompilerOptions) then
ExportRadioGroup.Visible:=False
else if Project1.BuildModes.Count <= 1 then
ExportRadioGroup.Enabled:=False;
with ButtonPanel1 do begin
OKButton.Caption:=lisIECOSaveToFile;

1
ide/lazarusidestrconsts.pas
View File

@ -1001,6 +1001,7 @@ resourcestring
lisIECOErrorOpeningXml = 'Error opening XML';
lisIECOErrorOpeningXmlFile = 'Error opening XML file "%s":%s%s';
lisImportingBuildModesNotSupported = 'Importing BuildModes is not supported for packages.';
lisSuccessfullyImportedBuildModes = 'Successfully imported %d BuildModes from "%s".';
lisSuccessfullyExportedBuildModes = 'Successfully exported %d BuildModes to "%s".';
lisSuccessfullyImportedCompilerOptions = 'Successfully imported compiler options from "%s".';

24
ide/main.pp
View File

@ -503,8 +503,8 @@ type
function OIOnPropertyHint(Sender: TObject; PointedRow: TOIPropertyGridRow;
out AHint: string): boolean;
procedure OIOnUpdateRestricted(Sender: TObject);
function OnPropHookGetMethodName(const Method: TMethod;
PropOwner: TObject): String;
function OnPropHookGetMethodName(const Method: TMethod; PropOwner: TObject;
OrigLookupRoot: TPersistent): String;
procedure OnPropHookGetMethods(TypeData: PTypeData; Proc:TGetStrProc);
procedure OnPropHookGetCompatibleMethods(InstProp: PInstProp;
const Proc:TGetStrProc);
@ -1823,8 +1823,10 @@ begin
(Sender as TObjectInspectorDlg).RestrictedProps := GetRestrictedProperties;
end;
function TMainIDE.OnPropHookGetMethodName(const Method: TMethod;
PropOwner: TObject): String;
function TMainIDE.OnPropHookGetMethodName(const Method: TMethod; PropOwner: TObject;
OrigLookupRoot: TPersistent): String;
// OrigLookupRoot can be different from the PropOwner's LookupRoot when we refer
// to an object (eg. TAction) in another form / unit.
var
JITMethod: TJITMethod;
LookupRoot: TPersistent;
@ -1836,16 +1838,17 @@ begin
Result:='<Unpublished>';
end else
Result:='<No LookupRoot>';
end else if IsJITMethod(Method) then begin
end
else if IsJITMethod(Method) then begin
JITMethod:=TJITMethod(Method.Data);
Result:=JITMethod.TheMethodName;
if PropOwner is TComponent then begin
LookupRoot:=GetLookupRootForComponent(TComponent(PropOwner));
if LookupRoot is TComponent then begin
//DebugLn(['TMainIDE.OnPropHookGetMethodName ',Result,' GlobalDesignHook.LookupRoot=',dbgsName(GlobalDesignHook.LookupRoot),' JITMethod.TheClass=',dbgsName(JITMethod.TheClass),' PropOwner=',DbgSName(PropOwner),' PropOwner-LookupRoot=',DbgSName(LookupRoot)]);
if (LookupRoot.ClassType<>JITMethod.TheClass) then begin
if (LookupRoot.ClassType<>JITMethod.TheClass)
or (LookupRoot<>OrigLookupRoot) then
Result:=JITMethod.TheClass.ClassName+'.'+Result;
end;
end;
end;
end else
@ -9193,13 +9196,14 @@ begin
Result:=TObject(Method.Data).MethodName(Method.Code)
else
Result:='';
end else if IsJITMethod(Method) then begin
end
else if IsJITMethod(Method) then begin
JITMethod:=TJITMethod(Method.Data);
Result:=JITMethod.TheMethodName;
if PropOwner is TComponent then begin
LookupRoot:=GetLookupRootForComponent(TComponent(PropOwner));
if LookupRoot is TComponent then begin
//DebugLn(['TMainIDE.OnPropHookGetMethodName ',Result,' ',dbgsName(GlobalDesignHook.LookupRoot),' ',dbgsName(JITMethod.TheClass)]);
//DebugLn(['TMainIDE.OnCodeToolBossGetMethodName ',Result,' GlobalDesignHook.LookupRoot=',dbgsName(GlobalDesignHook.LookupRoot),' JITMethod.TheClass=',dbgsName(JITMethod.TheClass),' PropOwner=',DbgSName(PropOwner),' PropOwner-LookupRoot=',DbgSName(LookupRoot)]);
if (LookupRoot.ClassType<>JITMethod.TheClass) then begin
Result:=JITMethod.TheClass.ClassName+'.'+Result;
end;
@ -9209,7 +9213,7 @@ begin
Result:='';
{$IFDEF VerboseDanglingComponentEvents}
if IsJITMethod(Method) then
DebugLn(['TMainIDE.OnPropHookGetMethodName ',Result,' ',IsJITMethod(Method)]);
DebugLn(['TMainIDE.OnCodeToolBossGetMethodName ',Result,' ',IsJITMethod(Method)]);
{$ENDIF}
end;