From 7d6d05a0bfce433a911bdccc9684b4246c23d346 Mon Sep 17 00:00:00 2001 From: juha Date: Mon, 24 Feb 2020 09:51:03 +0000 Subject: [PATCH] IDE: Change logic updating Application.Title and .Scaled in main source. Don't delete them when user option is off. Check for LCL app. git-svn-id: trunk@62669 - --- ide/frames/project_application_options.pas | 5 +- ide/frames/project_misc_options.pas | 20 +++-- ide/lazarusidestrconsts.pas | 6 +- ide/main.pp | 40 +++++----- ide/project.pp | 42 +++++++++- ide/projectdefs.pas | 2 +- ide/sourcefilemanager.pas | 90 ++++++++-------------- 7 files changed, 113 insertions(+), 92 deletions(-) diff --git a/ide/frames/project_application_options.pas b/ide/frames/project_application_options.pas index 0b0fd4e832..70fa5cab7e 100644 --- a/ide/frames/project_application_options.pas +++ b/ide/frames/project_application_options.pas @@ -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 diff --git a/ide/frames/project_misc_options.pas b/ide/frames/project_misc_options.pas index 5926c9ea91..eb7b159614 100644 --- a/ide/frames/project_misc_options.pas +++ b/ide/frames/project_misc_options.pas @@ -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); diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index d4a6dbc649..6f0790b13c 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -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.'; diff --git a/ide/main.pp b/ide/main.pp index 011932078e..a58bbc2d54 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -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; diff --git a/ide/project.pp b/ide/project.pp index 7eccc02846..85a94722b8 100644 --- a/ide/project.pp +++ b/ide/project.pp @@ -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) diff --git a/ide/projectdefs.pas b/ide/projectdefs.pas index d2ab6fc5f6..80d154c958 100644 --- a/ide/projectdefs.pas +++ b/ide/projectdefs.pas @@ -45,7 +45,7 @@ uses // LazUtils LazFileUtils, LazUTF8, Laz2_XMLCfg, // IdeIntf - ProjectIntf, LazIDEIntf, + ProjectIntf, // IDE PublishModule; diff --git a/ide/sourcefilemanager.pas b/ide/sourcefilemanager.pas index bd34073dd3..da685b7afb 100644 --- a/ide/sourcefilemanager.pas +++ b/ide/sourcefilemanager.pas @@ -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