paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-04 14:17:24 +01:00
Code Issues Packages Projects Releases Wiki Activity

IDE: Change logic updating Application.Title and .Scaled in main source. Don't delete them when user option is off. Check for LCL app.

Browse Source 
git-svn-id: trunk@62669 -
This commit is contained in:
juha 2020-02-24 09:51:03 +00:00
parent 5f31268a52
commit 7d6d05a0bf
7 changed files with 113 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
ide/frames/project_application_options.pas
View File

@ -305,7 +305,10 @@ begin
with FProject do
begin
TitleEdit.Text := Title;
UseLCLScalingCheckBox.Checked := Scaled;
if TProjectIDEOptions(AOptions).LclApp then
UseLCLScalingCheckBox.Checked := Scaled
else
UseLCLScalingCheckBox.Enabled := False; // Disable for a console program.
UseAppBundleCheckBox.Checked := UseAppBundle;
// Manifest
with ProjResources.XPManifest do

20
ide/frames/project_misc_options.pas
View File

@ -63,11 +63,12 @@ begin
MainUnitIsPascalSourceCheckBox.Hint := lisMainUnitIsPascalSourceHint;
MainUnitHasUsesSectionForAllUnitsCheckBox.Caption := lisMainUnitHasUsesSectionContainingAllUnitsOfProject;
MainUnitHasUsesSectionForAllUnitsCheckBox.Hint := lisNewUnitsAreAddedToUsesSections;
MainUnitHasCreateFormStatementsCheckBox.Caption := lisMainUnitHasApplicationCreateFormStatements;
MainUnitHasCreateFormStatementsCheckBox.Caption := lisUpdateApplicationCreateForm;
MainUnitHasCreateFormStatementsCheckBox.Hint := lisUsedForAutoCreatedForms;
MainUnitHasTitleStatementCheckBox.Caption := lisMainUnitHasApplicationTitleStatement;
MainUnitHasTitleStatementCheckBox.Caption := lisUpdateApplicationTitleStatement;
MainUnitHasTitleStatementCheckBox.Hint := lisIdeMaintainsTheTitleInMainUnit;
MainUnitHasScaledStatementCheckBox.Caption := lisMainUnitHasApplicationScaledStatement;
MainUnitHasScaledStatementCheckBox.Caption := lisUpdateApplicationScaledStatement;
MainUnitHasScaledStatementCheckBox.Hint := lisIdeMaintainsScaledInMainUnit;
CompatibilityModeCheckBox.Caption := lisLPICompatibilityModeCheckBox;
CompatibilityModeCheckBox.Hint := lisLPICompatibilityModeCheckBoxHint;
@ -96,9 +97,16 @@ begin
begin
MainUnitIsPascalSourceCheckBox.Checked := (pfMainUnitIsPascalSource in Flags);
MainUnitHasUsesSectionForAllUnitsCheckBox.Checked := (pfMainUnitHasUsesSectionForAllUnits in Flags);
MainUnitHasCreateFormStatementsCheckBox.Checked := (pfMainUnitHasCreateFormStatements in Flags);
MainUnitHasTitleStatementCheckBox.Checked := (pfMainUnitHasTitleStatement in Flags);
MainUnitHasScaledStatementCheckBox.Checked := (pfMainUnitHasScaledStatement in Flags);
if TProjectIDEOptions(AOptions).LclApp then begin
MainUnitHasCreateFormStatementsCheckBox.Checked := (pfMainUnitHasCreateFormStatements in Flags);
MainUnitHasTitleStatementCheckBox.Checked := (pfMainUnitHasTitleStatement in Flags);
MainUnitHasScaledStatementCheckBox.Checked := (pfMainUnitHasScaledStatement in Flags);
end
else begin // Disable these for a console program.
MainUnitHasCreateFormStatementsCheckBox.Enabled := False;
MainUnitHasTitleStatementCheckBox.Enabled := False;
MainUnitHasScaledStatementCheckBox.Enabled := False;
end;
CompatibilityModeCheckBox.Checked := (pfCompatibilityMode in Flags);
RunnableCheckBox.Checked := (pfRunnable in Flags);
UseDesignTimePkgsCheckBox.Checked := (pfUseDesignTimePackages in Flags);

6
ide/lazarusidestrconsts.pas
View File

@ -2755,11 +2755,11 @@ resourcestring
lisMainUnitIsPascalSourceHint = 'Assume Pascal even if it does not end with .pas/.pp suffix.';
lisMainUnitHasUsesSectionContainingAllUnitsOfProject = 'Main unit has Uses '
+'section containing all units of project';
lisMainUnitHasApplicationCreateFormStatements = 'Main unit has Application.CreateForm statements';
lisUpdateApplicationCreateForm = 'Update Application.CreateForm statements in main unit';
lisUsedForAutoCreatedForms = 'Used for auto-created forms.';
lisMainUnitHasApplicationTitleStatement = 'Main unit has Application.Title statement';
lisUpdateApplicationTitleStatement = 'Update Application.Title statement in main unit';
lisIdeMaintainsTheTitleInMainUnit = 'The IDE maintains the title in main unit.';
lisMainUnitHasApplicationScaledStatement = 'Main unit has Application.Scaled statement';
lisUpdateApplicationScaledStatement = 'Update Application.Scaled statement in main unit';
lisIdeMaintainsScaledInMainUnit = 'The IDE maintains Application.Scaled (Hi-DPI) in main unit.';
lisLPICompatibilityModeCheckBox = 'Maximize compatibility of project files (LPI and LPS)';
lisLPICompatibilityModeCheckBoxHint = 'Check this if you want to open your project in legacy (2.0 and older) Lazarus versions.';

40
ide/main.pp
View File

@ -5212,32 +5212,29 @@ begin
end;
procedure TMainIDE.ProjectOptionsBeforeRead(Sender: TObject);
var
ActiveSrcEdit: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
AProject: TProject;
//var
// ActiveSrcEdit: TSourceEditor;
// ActiveUnitInfo: TUnitInfo;
begin
//debugln(['TMainIDE.DoProjectOptionsBeforeRead ',DbgSName(Sender)]);
//DebugLn(['TMainIDE.DoProjectOptionsBeforeRead ',DbgSName(Sender)]);
if not (Sender is TProjectIDEOptions) then exit;
ActiveSrcEdit:=nil;
BeginCodeTool(ActiveSrcEdit, ActiveUnitInfo, []);
AProject:=TProjectIDEOptions(Sender).Project;
AProject.BackupSession;
AProject.BackupBuildModes;
AProject.UpdateExecutableType;
AProject.UseAsDefault := False;
Assert(Assigned(TProjectIDEOptions(Sender).Project), 'TMainIDE.ProjectOptionsBeforeRead: Project=Nil.');
//ActiveSrcEdit:=nil;
//BeginCodeTool(ActiveSrcEdit, ActiveUnitInfo, []);
Project1.BackupSession;
Project1.BackupBuildModes;
Project1.UpdateExecutableType;
Project1.UseAsDefault := False;
TProjectIDEOptions(Sender).CheckLclApp;
end;
procedure TMainIDE.ProjectOptionsAfterWrite(Sender: TObject; Restore: boolean);
var
aProject: TProject;
aFilename: String;
begin
//debugln(['TMainIDE.ProjectOptionsAfterWrite ',DbgSName(Sender),' Restore=',Restore]);
if not (Sender is TProjectIDEOptions) then exit;
aProject:=TProjectIDEOptions(Sender).Project;
Assert(Assigned(aProject), 'TMainIDE.ProjectOptionsAfterWrite: Project=Nil.');
Assert(aProject=Project1, 'TMainIDE.ProjectOptionsAfterWrite: Project<>Project1.');
Assert(Assigned(TProjectIDEOptions(Sender).Project), 'TMainIDE.ProjectOptionsAfterWrite: Project=Nil.');
if Restore then
begin
Project1.RestoreBuildModes;
@ -5246,9 +5243,12 @@ begin
else begin
if Project1.MainUnitID >= 0 then
begin
UpdateAppTitleInSource;
UpdateAppScaledInSource;
UpdateAppAutoCreateForms;
if TProjectIDEOptions(Sender).LclApp then
begin
UpdateAppTitleInSource;
UpdateAppScaledInSource;
UpdateAppAutoCreateForms;
end;
Project1.AutoAddOutputDirToIncPath; // extend include path
if Project1.ProjResources.Modified then
if not Project1.ProjResources.Regenerate(Project1.MainFilename, True, False, '') then
@ -6414,7 +6414,7 @@ begin
{$pop}
end;
function TMainIDE.DoSaveProject(Flags: TSaveFlags):TModalResult;
function TMainIDE.DoSaveProject(Flags: TSaveFlags): TModalResult;
begin
Result:=SaveProject(Flags);
end;

42
ide/project.pp
View File

@ -52,7 +52,7 @@ uses
LCLProc, Forms, Controls, Dialogs,
// CodeTools
CodeToolsConfig, ExprEval, DefineTemplates, BasicCodeTools, CodeToolsCfgScript,
LinkScanner, CodeToolManager, CodeCache, FileProcs,
LinkScanner, CodeToolManager, CodeCache, CodeTree, FileProcs,
// LazUtils
FPCAdds, LazUtilities, FileUtil, LazFileUtils, LazFileCache, LazMethodList,
LazLoggerBase, LazUTF8, Laz2_XMLCfg, Maps,
@ -676,13 +676,16 @@ type
TProjectIDEOptions = class(TAbstractIDEProjectOptions)
private
FProject: TProject;
FLclApp: Boolean;
public
constructor Create(AProject: TProject);
destructor Destroy; override;
function GetProject: TLazProject; override;
function CheckLclApp: Boolean;
class function GetInstance: TAbstractIDEOptions; override;
class function GetGroupCaption: string; override;
property Project: TProject read FProject;
property LclApp: Boolean read FLclApp;
end;
{ TProject }
@ -885,10 +888,10 @@ type
function NeedsDefineTemplates: boolean;
procedure BeginRevertUnit(AnUnitInfo: TUnitInfo);
procedure EndRevertUnit(AnUnitInfo: TUnitInfo);
function IsLclApplication: Boolean;
function IsReverting(AnUnitInfo: TUnitInfo): boolean;
// load/save
function IsVirtual: boolean; override;
// load/save
function SomethingModified(CheckData, CheckSession: boolean; Verbose: boolean = false): boolean;
function SomeDataModified(Verbose: boolean = false): boolean;
function SomeSessionModified(Verbose: boolean = false): boolean;
@ -2658,7 +2661,13 @@ end;
function TProjectIDEOptions.GetProject: TLazProject;
begin
Result:=FProject;
Result := FProject;
end;
function TProjectIDEOptions.CheckLclApp: Boolean;
begin
FLclApp := FProject.IsLclApplication;
Result := FLclApp;
end;
class function TProjectIDEOptions.GetInstance: TAbstractIDEOptions;
@ -4139,6 +4148,31 @@ begin
Result:=CodeBuf.Filename;
end;
function TProject.IsLclApplication: Boolean;
var
CodeTool: TCodeTool;
UsesNode: TCodeTreeNode;
begin
Result := False;
// LCL dependency must be there.
if FindDependencyByName('LCL') = Nil then Exit;
//DebugLn(['IsLclApplication: Found LCL dependency.']);
try
// Check is uses section has "Forms" unit.
if not CodeToolBoss.InitCurCodeTool(MainUnitInfo.Source) then Exit;
CodeTool := CodeToolBoss.CurCodeTool;
CodeTool.BuildTree(lsrMainUsesSectionEnd);
UsesNode := CodeTool.FindMainUsesNode;
if UsesNode = Nil then Exit;
//DebugLn(['IsLclApplication: Found "uses" node.']);
if CodeTool.FindNameInUsesSection(UsesNode, 'forms') = Nil then Exit;
//DebugLn(['IsLclApplication: Found "Forms" unit.']);
Result := True;
except
DebugLn(['IsLclApplication: Codetools could not parse the source.']);
end;
end;
function TProject.IsVirtual: boolean;
begin
Result:=((MainUnitID>=0) and MainUnitInfo.IsVirtual)

2
ide/projectdefs.pas
View File

@ -45,7 +45,7 @@ uses
// LazUtils
LazFileUtils, LazUTF8, Laz2_XMLCfg,
// IdeIntf
ProjectIntf, LazIDEIntf,
ProjectIntf,
// IDE
PublishModule;

90
ide/sourcefilemanager.pas
View File

@ -4314,73 +4314,51 @@ end;
function UpdateAppTitleInSource: Boolean;
var
TitleStat, ProjTitle: String;
TitleProject, ErrMsg: String;
begin
Result := True;
TitleStat := '';
CodeToolBoss.GetApplicationTitleStatement(Project1.MainUnitInfo.Source, TitleStat);
ProjTitle:=Project1.GetTitle;
//DebugLn(['UpdateAppTitleInSource: Project title=',ProjTitle,
// ', Default=',Project1.GetDefaultTitle,', Title Statement=',TitleStat]);
if pfMainUnitHasTitleStatement in Project1.Flags then
begin // Add Title statement if not there already.
if ((TitleStat = '') or (TitleStat = ProjTitle)) and Project1.TitleIsDefault then
Exit;
//DebugLn(['UpdateAppTitleInSource: Setting Title to ',ProjTitle]);
if not CodeToolBoss.SetApplicationTitleStatement(Project1.MainUnitInfo.Source, ProjTitle) then
begin
IDEMessageDialog(lisProjOptsError,
Format(lisUnableToChangeProjectTitleInSource, [LineEnding, CodeToolBoss.ErrorMessage]),
mtWarning, [mbOk]);
Result := False;
end;
if not (pfMainUnitHasTitleStatement in Project1.Flags) then Exit;
TitleProject := Project1.GetTitle;
//DebugLn(['UpdateAppTitleInSource: Project title=',TitleProject,', Default=',Project1.GetDefaultTitle]);
if (TitleProject <> Project1.GetDefaultTitle) then
begin // Add or update Title statement.
//DebugLn(['UpdateAppTitleInSource: Setting Title to ',TitleProject]);
Result := CodeToolBoss.SetApplicationTitleStatement(Project1.MainUnitInfo.Source, TitleProject);
ErrMsg := lisUnableToChangeProjectTitleInSource; // Used in case of error.
end
else begin // Remove Title statement if it is there.
if TitleStat <> ProjTitle then
Exit;
else begin // Remove Title statement if it's not needed.
//DebugLn(['UpdateAppTitleInSource: Removing Title']);
if not CodeToolBoss.RemoveApplicationTitleStatement(Project1.MainUnitInfo.Source) then
begin
IDEMessageDialog(lisProjOptsError,
Format(lisUnableToRemoveProjectTitleFromSource, [LineEnding, CodeToolBoss.ErrorMessage]),
mtWarning, [mbOk]);
Result := False;
end;
Result := CodeToolBoss.RemoveApplicationTitleStatement(Project1.MainUnitInfo.Source);
ErrMsg := lisUnableToRemoveProjectTitleFromSource;
end;
if not Result then
IDEMessageDialog(lisProjOptsError,
Format(ErrMsg, [LineEnding, CodeToolBoss.ErrorMessage]),
mtWarning, [mbOk]);
end;
function UpdateAppScaledInSource: Boolean;
var
ScaledStat, ProjScaled: Boolean;
ErrMsg: String;
begin
Result := True;
ScaledStat := False;
CodeToolBoss.GetApplicationScaledStatement(Project1.MainUnitInfo.Source, ScaledStat);
ProjScaled:=Project1.Scaled;
//DebugLn(['UpdateAppScaledInSource: Project Scaled=',ProjScaled,', Scaled Statement=',ScaledStat]);
if pfMainUnitHasScaledStatement in Project1.Flags then
begin // Add Scaled statement if not there already.
if ScaledStat = ProjScaled then
Exit;
//DebugLn(['UpdateAppScaledInSource: Setting Scaled to ',ProjScaled]);
if not CodeToolBoss.SetApplicationScaledStatement(Project1.MainUnitInfo.Source, ProjScaled) then
begin
IDEMessageDialog(lisProjOptsError,
Format(lisUnableToChangeProjectScaledInSource, [LineEnding, CodeToolBoss.ErrorMessage]),
mtWarning, [mbOk]);
Result := False;
end;
if not (pfMainUnitHasScaledStatement in Project1.Flags) then Exit;
//DebugLn(['UpdateAppScaledInSource: Project Scaled=',Project1.Scaled]);
if Project1.Scaled then
begin // Add or update Scaled statement.
//DebugLn(['UpdateAppScaledInSource: Setting Scaled to ',Project1.Scaled]);
Result := CodeToolBoss.SetApplicationScaledStatement(Project1.MainUnitInfo.Source, Project1.Scaled);
ErrMsg := lisUnableToChangeProjectScaledInSource; // Used in case of error.
end
else begin // Remove Scaled statement if it is there.
else begin // Remove Scaled statement if it's not needed.
//DebugLn(['UpdateAppScaledInSource: Removing Scaled']);
if not CodeToolBoss.RemoveApplicationScaledStatement(Project1.MainUnitInfo.Source) then
begin
IDEMessageDialog(lisProjOptsError,
Format(lisUnableToRemoveProjectScaledFromSource, [LineEnding, CodeToolBoss.ErrorMessage]),
mtWarning, [mbOk]);
Result := False;
end;
Result := CodeToolBoss.RemoveApplicationScaledStatement(Project1.MainUnitInfo.Source);
ErrMsg := lisUnableToRemoveProjectScaledFromSource;
end;
if not Result then
IDEMessageDialog(lisProjOptsError,
Format(ErrMsg, [LineEnding, CodeToolBoss.ErrorMessage]),
mtWarning, [mbOk]);
end;
function UpdateAppAutoCreateForms: boolean;
@ -4389,11 +4367,9 @@ var
OldList: TStrings;
begin
Result := True;
if not (pfMainUnitHasCreateFormStatements in Project1.Flags) then
Exit;
if not (pfMainUnitHasCreateFormStatements in Project1.Flags) then Exit;
OldList := Project1.GetAutoCreatedFormsList;
if OldList = nil then
Exit;
if OldList = nil then Exit;
try
if OldList.Count = Project1.TmpAutoCreatedForms.Count then
begin