diff --git a/.gitattributes b/.gitattributes index 06b35b2f96..3fa5c06556 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3525,6 +3525,8 @@ ide/charactermapdlg.lfm svneol=native#text/plain ide/charactermapdlg.pas svneol=native#text/pascal ide/checkcompileropts.lfm svneol=native#text/plain ide/checkcompileropts.pas svneol=native#text/pascal +ide/checkcompoptsfornewunitdlg.lfm svneol=native#text/plain +ide/checkcompoptsfornewunitdlg.pas svneol=native#text/plain ide/checklfmdlg.lfm svneol=native#text/plain ide/checklfmdlg.pas svneol=native#text/pascal ide/cleandirdlg.lfm svneol=native#text/plain diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index 3792860df4..2b72e2f6d3 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -122,6 +122,9 @@ const FPCProcessorNames: array[1..6] of shortstring =( 'i386', 'powerpc', 'm68k', 'x86_64', 'sparc', 'arm' ); + FPCSyntaxModes: array[1..5] of shortstring = ( + 'FPC', 'ObjFPC', 'Delphi', 'TP', 'MacPas' + ); Lazarus_CPU_OS_Widget_Combinations: array[1..62] of shortstring = ( 'i386-linux-gtk', diff --git a/ide/checkcompoptsfornewunitdlg.lfm b/ide/checkcompoptsfornewunitdlg.lfm new file mode 100644 index 0000000000..6756e73928 --- /dev/null +++ b/ide/checkcompoptsfornewunitdlg.lfm @@ -0,0 +1,92 @@ +object CheckCompOptsForNewUnitDialog: TCheckCompOptsForNewUnitDialog + Left = 272 + Height = 243 + Top = 255 + Width = 434 + Caption = 'CheckCompOptsForNewUnitDialog' + ClientHeight = 243 + ClientWidth = 434 + OnCreate = FormCreate + Position = poScreenCenter + LCLVersion = '0.9.29' + object NoteLabel: TLabel + Left = 6 + Height = 94 + Top = 6 + Width = 422 + Align = alTop + AutoSize = False + BorderSpacing.Around = 6 + Caption = 'NoteLabel' + ParentColor = False + WordWrap = True + end + object ModeLabel: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ModeComboBox + AnchorSideTop.Side = asrCenter + Left = 6 + Height = 18 + Top = 110 + Width = 78 + BorderSpacing.Left = 6 + Caption = 'ModeLabel' + ParentColor = False + end + object ModeComboBox: TComboBox + AnchorSideLeft.Control = ModeLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = NoteLabel + AnchorSideTop.Side = asrBottom + Left = 90 + Height = 27 + Top = 106 + Width = 135 + BorderSpacing.Left = 6 + ItemHeight = 0 + TabOrder = 0 + Text = 'ModeComboBox' + end + object AnsistringCheckBox: TCheckBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = ModeComboBox + AnchorSideTop.Side = asrBottom + Left = 6 + Height = 22 + Top = 139 + Width = 165 + BorderSpacing.Left = 6 + BorderSpacing.Top = 6 + Caption = 'AnsistringCheckBox' + TabOrder = 1 + end + object DoNotWarnCheckBox: TCheckBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = AnsistringCheckBox + AnchorSideTop.Side = asrBottom + Left = 6 + Height = 22 + Top = 171 + Width = 178 + BorderSpacing.Left = 6 + BorderSpacing.Top = 10 + Caption = 'DoNotWarnCheckBox' + TabOrder = 2 + end + object OkButton: TButton + AnchorSideTop.Control = DoNotWarnCheckBox + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + Left = 343 + Height = 27 + Top = 206 + Width = 85 + Anchors = [akRight, akBottom] + AutoSize = True + BorderSpacing.Around = 6 + Caption = 'OkButton' + OnClick = OkButtonClick + TabOrder = 3 + end +end diff --git a/ide/checkcompoptsfornewunitdlg.pas b/ide/checkcompoptsfornewunitdlg.pas new file mode 100644 index 0000000000..d89af4ab4f --- /dev/null +++ b/ide/checkcompoptsfornewunitdlg.pas @@ -0,0 +1,221 @@ +{ +*************************************************************************** +* * +* This source is free software; you can redistribute it and/or modify * +* it under the terms of the GNU General Public License as published by * +* the Free Software Foundation; either version 2 of the License, or * +* (at your option) any later version. * +* * +* This code is distributed in the hope that it will be useful, but * +* WITHOUT ANY WARRANTY; without even the implied warranty of * +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * +* General Public License for more details. * +* * +* A copy of the GNU General Public License is available on the World * +* Wide Web at . You can also * +* obtain it by writing to the Free Software Foundation, * +* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * +* * +*************************************************************************** + + Author: Mattias: Gaertner + + Abstract: + When a new unit is created check if compiler options in lpi and main source + differ. This is a common mistake when upgrading old projects. +} +unit CheckCompOptsForNewUnitDlg; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LCLProc, FileUtil, Forms, Controls, Graphics, Dialogs, + StdCtrls, ExtCtrls, + CodeToolManager, BasicCodeTools, DefineTemplates, + ProjectIntf, IDEDialogs, + InputHistory, TransferMacros, Project, LazarusIDEStrConsts; + +type + + { TCheckCompOptsForNewUnitDialog } + + TCheckCompOptsForNewUnitDialog = class(TForm) + AnsistringCheckBox: TCheckBox; + DoNotWarnCheckBox: TCheckBox; + OkButton: TButton; + ModeComboBox: TComboBox; + ModeLabel: TLabel; + NoteLabel: TLabel; + procedure FormCreate(Sender: TObject); + procedure OkButtonClick(Sender: TObject); + private + FMainAnsistring: char; + FMainMode: string; + public + CompOpts: TLazCompilerOptions; + procedure UpdateOptions; + property MainMode: string read FMainMode write FMainMode; + property MainAnsistring: char read FMainAnsistring write FMainAnsistring; + end; + +procedure CheckCompOptsAndMainSrcForNewUnit(CompOpts: TLazCompilerOptions); +function GetIgnorePathForCompOptsAndMainSrcDiffer(CompOpts: TLazCompilerOptions): string; + +implementation + +procedure CheckCompOptsAndMainSrcForNewUnit(CompOpts: TLazCompilerOptions); +var + ProjCompOpts: TProjectCompilerOptions; + MainUnit: TUnitInfo; + Src: String; + StartPos: Integer; + p: PChar; + Mode: String; + AnsistringMode: Char; + NestedComments: Boolean; + Dlg: TCheckCompOptsForNewUnitDialog; + IgnoreIdentifier: String; +begin + if CompOpts is TProjectCompilerOptions then + begin + ProjCompOpts:=TProjectCompilerOptions(CompOpts); + if (ProjCompOpts.LazProject=nil) then exit; + MainUnit:=ProjCompOpts.LazProject.MainUnitInfo; + if (MainUnit=nil) or (MainUnit.Source=nil) then exit; + + // check if this question should be ignored + IgnoreIdentifier:=GetIgnorePathForCompOptsAndMainSrcDiffer(CompOpts); + if (IgnoreIdentifier<>'') + and (InputHistories.Ignores.Find(IgnoreIdentifier)<>nil) then + exit; + + Src:=MainUnit.Source.Source; + Mode:=''; + AnsistringMode:=#0; + StartPos:=1; + NestedComments:=false; + repeat + StartPos:=FindNextCompilerDirective(Src,StartPos,NestedComments); + if StartPos>length(Src) then break; + p:=@Src[StartPos]; + StartPos:=FindCommentEnd(Src,StartPos,NestedComments); + if p^<>'{' then continue; + inc(p); + if p^<>'$' then continue; + inc(p); + if (Mode='') and (CompareIdentifiers(p,'mode')=0) then begin + // mode directive + inc(p,4); + while p^ in [' ',#9] do inc(p); + Mode:=GetIdentifier(p); + end + else if (AnsistringMode=#0) and (p^='H') and (p[1] in ['+','-']) then begin + // ansistring directive + AnsistringMode:=p[1]; + end; + until false; + //debugln(['CheckCompOptsAndMainSrcForNewUnit Mode=',Mode,' ProjMode=',ProjCompOpts.SyntaxMode,' Str=',AnsistringMode='+',' ProjStr=',ProjCompOpts.UseAnsiStrings]); + if ((Mode<>'') and (SysUtils.CompareText(Mode,ProjCompOpts.SyntaxMode)<>0)) + or ((AnsistringMode<>#0) and ((AnsistringMode='+')<>ProjCompOpts.UseAnsiStrings)) + then begin + Dlg:=TCheckCompOptsForNewUnitDialog.Create(nil); + try + Dlg.CompOpts:=CompOpts; + Dlg.MainMode:=Mode; + Dlg.MainAnsistring:=AnsistringMode; + Dlg.UpdateOptions; + Dlg.ShowModal; + finally + Dlg.Free; + end; + end; + end; +end; + +function GetIgnorePathForCompOptsAndMainSrcDiffer(CompOpts: TLazCompilerOptions + ): string; +var + ProjCompOpts: TProjectCompilerOptions; +begin + Result:=''; + if (CompOpts is TProjectCompilerOptions) then + begin + ProjCompOpts:=TProjectCompilerOptions(CompOpts); + if ProjCompOpts.LazProject<>nil then + Result:='NewUnitProjOptsAndMainSrcDiffer/'+ProjCompOpts.LazProject.ProjectInfoFile; + end; +end; + +{$R *.lfm} + +{ TCheckCompOptsForNewUnitDialog } + +procedure TCheckCompOptsForNewUnitDialog.FormCreate(Sender: TObject); +var + sl: TStringList; + i: Integer; +begin + Caption:=lisDirectivesForNewUnit; + OkButton.Caption:=lisContinue; + + ModeLabel.Caption:=lisSyntaxMode; + sl:=TStringList.Create; + for i:=low(FPCSyntaxModes) to high(FPCSyntaxModes) do + sl.Add(FPCSyntaxModes[i]); + ModeComboBox.Items.Assign(sl); + sl.Free; + AnsistringCheckBox.Caption:=lisUseAnsistrings; + DoNotWarnCheckBox.Caption:=lisDoNotShowThisDialogForThisProject; +end; + +procedure TCheckCompOptsForNewUnitDialog.OkButtonClick(Sender: TObject); +var + NewMode: String; + i: Integer; + IgnoreIdentifier: String; +begin + NewMode:=ModeComboBox.Text; + if SysUtils.CompareText(CompOpts.SyntaxMode,NewMode)<>0 then + begin + i:=low(FPCSyntaxModes); + while (i<=High(FPCSyntaxModes)) + and (SysUtils.CompareText(FPCSyntaxModes[i],NewMode)<>0) do + inc(i); + if i>High(FPCSyntaxModes) then + begin + MessageDlg(lisCCOErrorCaption, Format(lisInvalidMode, [NewMode]), + mtError, [mbCancel + ], 0); + exit; + end; + end; + + if (CompOpts.UseAnsiStrings<>AnsistringCheckBox.Checked) + or (CompOpts.SyntaxMode<>NewMode) then + begin + CompOpts.UseAnsiStrings:=AnsistringCheckBox.Checked; + CompOpts.SyntaxMode:=NewMode; + IncreaseCompilerParseStamp; + end; + + if DoNotWarnCheckBox.Checked then + begin + IgnoreIdentifier:=GetIgnorePathForCompOptsAndMainSrcDiffer(CompOpts); + if IgnoreIdentifier<>'' then; + InputHistories.Ignores.Add(IgnoreIdentifier,iiidForever); + end; + + ModalResult:=mrOk; +end; + +procedure TCheckCompOptsForNewUnitDialog.UpdateOptions; +begin + NoteLabel.Caption:=lisTheProjectCompilerOptionsAndTheDirectivesInTheMain; + AnsistringCheckBox.Checked:=CompOpts.UseAnsiStrings; + ModeComboBox.Text:=CompOpts.SyntaxMode; +end; + +end. + diff --git a/ide/lazarus.lpi b/ide/lazarus.lpi index 098a800dd1..1c95e44bef 100644 --- a/ide/lazarus.lpi +++ b/ide/lazarus.lpi @@ -56,7 +56,7 @@ - + @@ -555,6 +555,13 @@ + + + + + + + diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index 7545f55ed4..494c213b11 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -1901,6 +1901,10 @@ resourcestring dlgCCOTestMissingPPU = 'Test: Checking missing fpc ppu ...'; dlgCCOTestCompilerDate = 'Test: Checking compiler date ...'; lisCCOErrorCaption = 'Error'; + lisInvalidMode = 'Invalid mode %s'; + lisTheProjectCompilerOptionsAndTheDirectivesInTheMain = 'The project ' + +'compiler options and the directives in the main source differ. For the ' + +'new unit the mode and string type of the project options are used:'; lisThereIsAlreadyAnIDEMacroWithTheName = 'There is already an IDE macro ' +'with the name "%s"'; lisInvalidLineColumnInMessage = 'Invalid line, column in message%s%s'; @@ -4589,6 +4593,9 @@ resourcestring lisIdentifier = 'identifier'; lisProjectUnit = 'project unit'; lisSyntaxMode = 'Syntax mode'; + lisUseAnsistrings = 'Use Ansistrings'; + lisDoNotShowThisDialogForThisProject = 'Do not show this dialog for this ' + +'project'; lisObjectPascalDefault = 'Object Pascal - default'; lisDelphi = 'Delphi'; lisTurboPascal = 'Turbo Pascal'; @@ -4930,6 +4937,7 @@ resourcestring lisChangeBuildMode = 'Change build mode'; lisWarningThisIsTheMainUnitTheNewMainUnitWillBePas = '%sWarning: This is ' +'the main unit. The new main unit will be %s.pas.'; + lisDirectivesForNewUnit = 'Directives for new unit'; implementation diff --git a/ide/main.pp b/ide/main.pp index 7cdc19aeb9..87b0d12256 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -135,7 +135,7 @@ uses CodeTemplatesDlg, CodeBrowser, FindUnitDlg, IdeOptionsDlg, EditDefineTree, PublishModule, EnvironmentOpts, TransferMacros, KeyMapping, IDETranslations, IDEProcs, ExtToolDialog, ExtToolEditDlg, OutputFilter, JumpHistoryView, - BuildLazDialog, BuildProfileManager, BuildManager, + BuildLazDialog, BuildProfileManager, BuildManager, CheckCompOptsForNewUnitDlg, MiscOptions, InputHistory, UnitDependencies, ClipBoardHistory, IDEFPCInfo, ProcessList, InitialSetupDlgs, NewDialog, MakeResStrDlg, DialogProcs, FindReplaceDialog, FindInFilesDlg, CodeExplorer, BuildFileDlg, @@ -514,6 +514,7 @@ type // compiler options dialog events procedure OnCompilerOptionsDialogTest(Sender: TObject); + procedure OnCheckCompOptsAndMainSrcForNewUnit(CompOpts: TLazCompilerOptions); // unit dependencies events procedure UnitDependenciesViewAccessingSources(Sender: TObject); @@ -1828,6 +1829,7 @@ begin IDEMessageDialog:=@OnIDEMessageDialog; IDEQuestionDialog:=@OnIDEQuestionDialog; TestCompilerOptions:=@OnCompilerOptionsDialogTest; + CheckCompOptsAndMainSrcForNewUnitEvent:=@OnCheckCompOptsAndMainSrcForNewUnit; end; procedure TMainIDE.SetupComponentPalette; @@ -16342,6 +16344,12 @@ begin DoTestCompilerSettings(Sender as TCompilerOptions); end; +procedure TMainIDE.OnCheckCompOptsAndMainSrcForNewUnit( + CompOpts: TLazCompilerOptions); +begin + CheckCompOptsAndMainSrcForNewUnit(CompOpts); +end; + procedure TMainIDE.ProjInspectorOpen(Sender: TObject); var CurUnitInfo: TUnitInfo; diff --git a/ideintf/projectintf.pas b/ideintf/projectintf.pas index 4da1e7b26d..f0de9f7626 100644 --- a/ideintf/projectintf.pas +++ b/ideintf/projectintf.pas @@ -589,6 +589,11 @@ function FileDescriptorForm: TProjectFileDescriptor; function FileDescriptorDatamodule: TProjectFileDescriptor; function FileDescriptorText: TProjectFileDescriptor; +type + TCheckCompOptsAndMainSrcForNewUnitEvent = + procedure(CompOpts: TLazCompilerOptions) of object; +var + CheckCompOptsAndMainSrcForNewUnitEvent: TCheckCompOptsAndMainSrcForNewUnitEvent; // set by the IDE type TLazProject = class; @@ -1152,6 +1157,8 @@ var begin Result:='{$mode objfpc}{$H+}'; if CompOpts=nil then exit; + if Assigned(CheckCompOptsAndMainSrcForNewUnitEvent) then + CheckCompOptsAndMainSrcForNewUnitEvent(CompOpts); SyntaxMode:=CompOpts.SyntaxMode; if SyntaxMode<>'' then begin Result:='{$mode '+lowercase(SyntaxMode)+'}';