From f36557e1c9c5815d7b9de844a2b46ab7eb40e12c Mon Sep 17 00:00:00 2001 From: juha Date: Tue, 30 Jul 2013 09:14:43 +0000 Subject: [PATCH] IDE: Improve Conditional Define GUI. git-svn-id: trunk@42233 - --- ide/condef.lfm | 177 ++++++++++++++------- ide/condef.pas | 411 +++++++++++++++++++++++++++++-------------------- 2 files changed, 362 insertions(+), 226 deletions(-) diff --git a/ide/condef.lfm b/ide/condef.lfm index 124b5584fe..951e03978d 100644 --- a/ide/condef.lfm +++ b/ide/condef.lfm @@ -8,26 +8,25 @@ object CondForm: TCondForm Caption = 'Conditional Defines' ClientHeight = 326 ClientWidth = 356 - OnClose = CondFormCLOSE OnCreate = CondFormCREATE OnShow = FormShow Position = poScreenCenter - LCLVersion = '0.9.27' + LCLVersion = '1.1' object NewTestGroupBox: TGroupBox Left = 6 - Height = 137 + Height = 149 Top = 6 Width = 344 Align = alTop AutoSize = True BorderSpacing.Around = 6 Caption = 'NewTestGroupBox' - ClientHeight = 119 + ClientHeight = 130 ClientWidth = 340 TabOrder = 0 object FirstLabel: TLabel Left = 6 - Height = 14 + Height = 15 Top = 6 Width = 328 Align = alTop @@ -40,8 +39,8 @@ object CondForm: TCondForm object SecondLabel: TLabel AnchorSideTop.Side = asrBottom Left = 6 - Height = 14 - Top = 47 + Height = 15 + Top = 52 Width = 328 Align = alTop BorderSpacing.Left = 6 @@ -53,15 +52,14 @@ object CondForm: TCondForm object FirstTest: TComboBox AnchorSideTop.Side = asrBottom Left = 6 - Height = 21 - Top = 20 + Height = 25 + Top = 21 Width = 328 Align = alTop - AutoComplete = False BorderSpacing.Left = 6 BorderSpacing.Right = 6 BorderSpacing.Bottom = 6 - ItemHeight = 13 + ItemHeight = 0 ItemIndex = 0 Items.Strings = ( 'MSWINDOWS' @@ -75,39 +73,37 @@ object CondForm: TCondForm 'KYLIX' 'VER1_0' ) - ItemWidth = 0 + OnChange = TestEditChange TabOrder = 0 Text = 'MSWINDOWS' end object SecondTest: TComboBox AnchorSideTop.Side = asrBottom Left = 6 - Height = 21 - Top = 61 + Height = 25 + Top = 67 Width = 328 Align = alTop - AutoComplete = False BorderSpacing.Left = 6 BorderSpacing.Right = 6 BorderSpacing.Bottom = 6 - ItemHeight = 13 + ItemHeight = 0 ItemIndex = 0 Items.Strings = ( 'NONE' 'ELSE' ) - ItemWidth = 0 + OnChange = TestEditChange TabOrder = 1 Text = 'NONE' end object AddBtn: TBitBtn - AnchorSideLeft.Control = NewTestGroupBox AnchorSideTop.Control = SecondTest AnchorSideTop.Side = asrBottom AnchorSideRight.Control = AddInverse - Left = 89 - Height = 25 - Top = 88 + Left = 85 + Height = 26 + Top = 98 Width = 75 Anchors = [akTop, akRight] AutoSize = True @@ -115,20 +111,37 @@ object CondForm: TCondForm Caption = '&Add' Constraints.MinHeight = 25 Constraints.MinWidth = 75 - NumGlyphs = 0 OnClick = AddBtnClick TabOrder = 2 end - object AddInverse: TButton - AnchorSideLeft.Control = AddBtn + object RemoveBtn: TBitBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = SecondTest + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = NewTestGroupBox + AnchorSideRight.Side = asrBottom + Left = 259 + Height = 26 + Top = 98 + Width = 75 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Around = 6 + Caption = '&Remove' + Constraints.MinHeight = 25 + Constraints.MinWidth = 75 + OnClick = RemoveBtnClick + TabOrder = 3 + end + object AddInverse: TBitBtn AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = SecondTest AnchorSideTop.Side = asrBottom AnchorSideRight.Control = RemoveBtn - Left = 170 - Height = 25 - Top = 88 - Width = 83 + Left = 166 + Height = 26 + Top = 98 + Width = 87 HelpType = htKeyword Anchors = [akTop, akRight] AutoSize = True @@ -137,51 +150,97 @@ object CondForm: TCondForm Constraints.MinHeight = 25 Constraints.MinWidth = 75 OnClick = AddInverseCLICK - TabOrder = 3 - end - object RemoveBtn: TBitBtn - AnchorSideLeft.Control = AddInverse - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = SecondTest - AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = NewTestGroupBox - AnchorSideRight.Side = asrBottom - Left = 259 - Height = 25 - Top = 88 - Width = 75 - Anchors = [akTop, akRight] - AutoSize = True - BorderSpacing.Around = 6 - Caption = '&Remove' - Constraints.MinHeight = 25 - Constraints.MinWidth = 75 - NumGlyphs = 0 - OnClick = RemoveBtnClick TabOrder = 4 end end object ListBox: TListBox - AnchorSideTop.Side = asrBottom Left = 6 - Height = 139 - Top = 149 + Height = 113 + Top = 161 Width = 344 Align = alClient Anchors = [akTop, akBottom] BorderSpacing.Around = 6 ItemHeight = 0 + OnClick = ListBoxClick OnDblClick = ListBoxDblClick OnKeyDown = ListBoxKeyDown TabOrder = 1 end - object ButtonPanel: TButtonPanel - Left = 6 - Height = 26 - Top = 294 - Width = 344 + object ButtonPanel: TPanel + Left = 0 + Height = 46 + Top = 280 + Width = 356 + Align = alBottom + ClientHeight = 46 + ClientWidth = 356 TabOrder = 2 - ShowButtons = [pbOK, pbCancel, pbHelp] - ShowBevel = False + object btnOk: TBitBtn + AnchorSideTop.Control = ButtonPanel + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ButtonPanel + AnchorSideRight.Side = asrBottom + Left = 290 + Height = 27 + Top = 10 + Width = 59 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Around = 6 + Default = True + DefaultCaption = True + Kind = bkOK + ModalResult = 1 + OnClick = OKButtonClick + TabOrder = 0 + end + object btnSave: TBitBtn + AnchorSideTop.Control = btnOk + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = btnOk + Left = 219 + Height = 26 + Top = 10 + Width = 65 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 6 + Caption = 'btnSave' + ModalResult = 6 + OnClick = btnSaveClick + TabOrder = 1 + end + object btmCancel: TBitBtn + AnchorSideTop.Control = btnSave + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = btnSave + Left = 123 + Height = 33 + Top = 7 + Width = 90 + Anchors = [akTop, akRight] + AutoSize = True + BorderSpacing.Right = 6 + Cancel = True + DefaultCaption = True + Kind = bkCancel + ModalResult = 2 + TabOrder = 2 + end + object btnHelp: TBitBtn + AnchorSideLeft.Control = ButtonPanel + AnchorSideTop.Control = ButtonPanel + AnchorSideTop.Side = asrCenter + Left = 7 + Height = 30 + Top = 8 + Width = 75 + BorderSpacing.Around = 6 + DefaultCaption = True + Kind = bkHelp + OnClick = HelpButtonClick + TabOrder = 3 + end end end diff --git a/ide/condef.pas b/ide/condef.pas index 3668192bf8..51086bf0c1 100644 --- a/ide/condef.pas +++ b/ide/condef.pas @@ -53,9 +53,8 @@ interface uses Classes, SysUtils, Graphics, Controls, Forms, LCLProc, Dialogs, - StdCtrls, Buttons, FileUtil, Laz2_XMLCfg, ButtonPanel, - IDEHelpIntf, - LazarusIDEStrConsts, IDEProcs; + StdCtrls, Buttons, FileUtil, Laz2_XMLCfg, ButtonPanel, ExtCtrls, + IDEHelpIntf, LazarusIDEStrConsts, IDEProcs, strutils; type @@ -63,8 +62,12 @@ type TCondForm = class(TForm) AddBtn: TBitBtn; - AddInverse: TButton; - ButtonPanel: TButtonPanel; + AddInverse: TBitBtn; + btnHelp: TBitBtn; + btmCancel: TBitBtn; + btnSave: TBitBtn; + btnOk: TBitBtn; + ButtonPanel: TPanel; FirstLabel: TLabel; FirstTest: TComboBox; ListBox: TListBox; @@ -74,18 +77,24 @@ type SecondTest: TComboBox; procedure AddBtnClick(Sender: TObject); procedure AddInverseCLICK(Sender: TObject); + procedure btnSaveClick(Sender: TObject); + procedure OKButtonClick(Sender: TObject); + procedure TestEditChange(Sender: TObject); procedure HelpButtonClick(Sender: TObject); - procedure CondFormCLOSE(Sender: TObject; var CloseAction: TCloseAction); procedure CondFormCREATE(Sender: TObject); + procedure ListBoxClick(Sender: TObject); procedure ListBoxDblClick(Sender: TObject); procedure RemoveBtnClick(Sender: TObject); - procedure ListBoxKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); + procedure ListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormShow(Sender: TObject); - public - Choice, First, Second, FS: string; + private + StoredChoice, StoredFirst, StoredSecond: string; + FS: string; + function SplitActiveRow(var aFirst, aSecond: string): Boolean; procedure DeleteSelected; - procedure SaveChoices; + procedure UpdateButtons; + function IsChanged: Boolean; + procedure SaveIfChanged; function CreateXMLConfig: TXMLConfig; end; @@ -102,15 +111,13 @@ uses function ShowConDefDlg: string; var - DialogResult: Integer; CondForm: TCondForm; begin Result := ''; CondForm := TCondForm.Create(nil); try CondForm.ActiveControl := CondForm.ListBox; - DialogResult := CondForm.ShowModal; - if DialogResult <> mrOK then + if CondForm.ShowModal <> mrOK then Result := '' else Result := CondForm.FS; @@ -119,159 +126,6 @@ begin end end; -procedure TCondForm.AddBtnClick(Sender: TObject); -begin - ListBox.Items.Add(FirstTest.Text+','+SecondTest.Text); -end; - -procedure TCondForm.AddInverseCLICK(Sender: TObject); -begin - ListBox.Items.Add('!'+FirstTest.Text+','+SecondTest.Text); -end; - -procedure TCondForm.HelpButtonClick(Sender: TObject); -begin - LazarusHelp.ShowHelpForIDEControl(Self); -end; - -procedure TCondForm.CondFormCLOSE(Sender: TObject; var CloseAction: TCloseAction); -var - SChanged: Boolean; - i: Integer; - procedure SUpdate(var s: string; n: string); - begin - if s <> n then begin - SChanged := True; - s := n; - end; - end; -begin - SChanged := False; - with ListBox do begin - SUpdate(Choice,Items.CommaText); - if ItemIndex >= 0 then begin - FS := Items[ItemIndex]; - i := Pos(',', FS); - if i > 0 then begin - SUpdate(First, Copy(FS, 1, i-1)); - SUpdate(Second, Copy(FS, i+1, Length(FS))); - end - end; - end; - if SChanged then - SaveChoices; -end; - -procedure TCondForm.CondFormCREATE(Sender: TObject); -var - i: Integer; - XMLConfig: TXMLConfig; -begin - NewTestGroupBox.Caption := rsCreateNewDefine; - Caption := rsConditionalDefines; - AddBtn.Caption := lisBtnAdd; - AddInverse.Caption := rsAddInverse; - RemoveBtn.Caption := lisBtnRemove; - ButtonPanel.HelpButton.OnClick := @HelpButtonClick; - try - XMLConfig:=CreateXMLConfig; - try - Choice := XMLConfig.GetValue('condef/Choice', '"MSWINDOWS,UNIX","MSWINDOWS,ELSE","FPC,NONE","FPC,ELSE","DEBUG,NONE"'); - First := XMLConfig.GetValue('condef/First', 'MSWINDOWS'); - Second := XMLConfig.GetValue('condef/Second', 'UNIX'); - finally - XMLConfig.Free; - end; - except - on E: Exception do begin - debugln('TCondForm.CondFormCREATE ',E.Message); - end; - end; - with ListBox do begin - Items.CommaText := Choice; - i := Items.IndexOf(First+','+Second); - if i < 0 then begin - Items.Add(First+','+Second); - ItemIndex := 0; - end else - ItemIndex := i; - end; -end; - -procedure TCondForm.ListBoxDblClick(Sender: TObject); -begin - ModalResult := mrOK; -end; - -procedure TCondForm.RemoveBtnClick(Sender: TObject); -begin - DeleteSelected; -end; - -procedure TCondForm.ListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); -begin - if Key = VK_DELETE then begin - DeleteSelected; - Key := 0; - end; -end; - -procedure TCondForm.FormShow(Sender: TObject); -begin - if SecondTest.Items.Count < 10 then - SecondTest.Items.AddStrings(FirstTest.Items); -end; - -procedure TCondForm.DeleteSelected; -var - i: Integer; -begin - with ListBox.Items do - for i := Count-1 downto 0 do - if ListBox.Selected[i] then - Delete(i); -end; - -procedure TCondForm.SaveChoices; -var - XMLConfig: TXMLConfig; -begin - try - InvalidateFileStateCache; - XMLConfig:=CreateXMLConfig; - try - XMLConfig.SetValue('condef/Choice', Choice); - XMLConfig.SetValue('condef/First', First); - XMLConfig.SetValue('condef/Second', Second); - XMLConfig.Flush; - finally - XMLConfig.Free; - end; - except - on E: Exception do begin - debugln('TCondForm.SaveChoices ',E.Message); - end; - end; -end; - -function TCondForm.CreateXMLConfig: TXMLConfig; -var - ConfFileName: String; -begin - Result:=nil; - ConfFileName:=SetDirSeparators(GetPrimaryConfigPath+'/condef.xml'); - try - if (not FileExistsUTF8(ConfFileName)) then - Result:=TXMLConfig.CreateClean(ConfFileName) - else - Result:=TXMLConfig.Create(ConfFileName); - except - on E: Exception do begin - debugln('TCondForm.CreateXMLConfig ',E.Message); - end; - end; -end; - function AddConditional(Text: string; IsPascal: Boolean):string; var cond, s, f: string; @@ -373,4 +227,227 @@ begin end; end; +{ TCondForm } + +procedure TCondForm.CondFormCREATE(Sender: TObject); +var + i: Integer; + XMLConfig: TXMLConfig; +begin + NewTestGroupBox.Caption := rsCreateNewDefine; + Caption := rsConditionalDefines; + AddBtn.Caption := lisBtnAdd; + AddBtn.LoadGlyphFromLazarusResource('laz_add'); + AddInverse.Caption := rsAddInverse; + AddInverse.LoadGlyphFromLazarusResource('pkg_issues'); + RemoveBtn.Caption := lisBtnRemove; + RemoveBtn.LoadGlyphFromLazarusResource('laz_delete'); + btnSave.Caption := lisSave; + btnSave.LoadGlyphFromStock(idButtonSave); + btnOk.Caption := dlgButApply; + //if btnSave.Glyph.Empty then + // btnSave.LoadGlyphFromLazarusResource('laz_save'); + try + XMLConfig:=CreateXMLConfig; + try + StoredChoice := XMLConfig.GetValue('condef/Choice', + '"MSWINDOWS,UNIX","MSWINDOWS,ELSE","FPC,NONE","FPC,ELSE","DEBUG,NONE"'); + StoredFirst := XMLConfig.GetValue('condef/First', 'MSWINDOWS'); + StoredSecond := XMLConfig.GetValue('condef/Second', 'UNIX'); + finally + XMLConfig.Free; + end; + except + on E: Exception do begin + debugln('TCondForm.CondFormCREATE ',E.Message); + end; + end; + with ListBox do begin + Items.CommaText := StoredChoice; + i := Items.IndexOf(StoredFirst+','+StoredSecond); + if i < 0 then begin + Items.Add(StoredFirst+','+StoredSecond); + ItemIndex := 0; + end else + ItemIndex := i; + end; +end; + +procedure TCondForm.FormShow(Sender: TObject); +begin + if SecondTest.Items.Count < 10 then + SecondTest.Items.AddStrings(FirstTest.Items); + ListBoxClick(Nil); +end; + +function TCondForm.SplitActiveRow(var aFirst, aSecond: string): Boolean; +var + i: integer; + Line: string; +begin + Result := False; + aFirst := ''; + aSecond := ''; + with ListBox do + if ItemIndex >= 0 then begin + Line := Items[ItemIndex]; + i := Pos(',', Line); + if i > 0 then begin + Result := True; + aFirst := Copy(Line, 1, i-1); + aSecond := Copy(Line, i+1, Length(Line)); + end + end; +end; + +procedure TCondForm.AddBtnClick(Sender: TObject); +begin + ListBox.Items.Add(FirstTest.Text+','+SecondTest.Text); + ListBox.ItemIndex := ListBox.Items.Count-1; + UpdateButtons; +end; + +procedure TCondForm.AddInverseCLICK(Sender: TObject); +begin + ListBox.Items.Add('!'+FirstTest.Text+','+SecondTest.Text); + ListBox.ItemIndex := ListBox.Items.Count-1; + UpdateButtons; +end; + +procedure TCondForm.TestEditChange(Sender: TObject); +begin + UpdateButtons; +end; + +procedure TCondForm.btnSaveClick(Sender: TObject); +begin + SaveIfChanged; + Close; +end; + +procedure TCondForm.OKButtonClick(Sender: TObject); +begin + SaveIfChanged; + with ListBox do + FS := Items[ItemIndex]; // Return selected row to caller. +end; + +procedure TCondForm.HelpButtonClick(Sender: TObject); +begin + LazarusHelp.ShowHelpForIDEControl(Self); +end; + +procedure TCondForm.ListBoxClick(Sender: TObject); +var + ff, ss: string; +begin + if SplitActiveRow(ff, ss) then begin + FirstTest.Text := ff; + SecondTest.Text := ss; + UpdateButtons; + end; +end; + +procedure TCondForm.ListBoxDblClick(Sender: TObject); +begin + ModalResult := mrOK; +end; + +procedure TCondForm.RemoveBtnClick(Sender: TObject); +begin + DeleteSelected; +end; + +procedure TCondForm.ListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if Key = VK_DELETE then begin + DeleteSelected; + Key := 0; + end; +end; + +procedure TCondForm.DeleteSelected; +var + i: Integer; +begin + with ListBox.Items do + for i := Count-1 downto 0 do + if ListBox.Selected[i] then begin + Delete(i); + UpdateButtons; + end; +end; + +procedure TCondForm.UpdateButtons; +var + s: string; +begin + s := FirstTest.Text+','+SecondTest.Text; + AddBtn.Enabled := ListBox.Items.IndexOf(s) = -1; + s := '!'+s; + AddInverse.Enabled := not AnsiStartsStr('!', FirstTest.Text) + and (ListBox.Items.IndexOf(s) = -1); + RemoveBtn.Enabled := ListBox.SelCount > 0; + btnSave.Enabled := IsChanged; + btnOk.Enabled := ListBox.SelCount > 0; +end; + +function TCondForm.IsChanged: Boolean; +var + ff, ss: string; +begin + if StoredChoice <> ListBox.Items.CommaText then + Exit(True); + if SplitActiveRow(ff, ss) then begin + if StoredFirst <> ff then + Exit(True); + if StoredSecond <> ss then + Exit(True); + end; + Result := False; +end; + +procedure TCondForm.SaveIfChanged; +var + ff, ss: string; + XMLConfig: TXMLConfig; +begin + if btnSave.Enabled then // Is enabled only if there are changes + try + SplitActiveRow(ff, ss); + InvalidateFileStateCache; + XMLConfig:=CreateXMLConfig; + try + XMLConfig.SetValue('condef/Choice', ListBox.Items.CommaText); + XMLConfig.SetValue('condef/First', ff); + XMLConfig.SetValue('condef/Second', ss); + XMLConfig.Flush; + finally + XMLConfig.Free; + end; + except + on E: Exception do begin + debugln('TCondForm.SaveIfChanged ',E.Message); + end; + end; +end; + +function TCondForm.CreateXMLConfig: TXMLConfig; +var + ConfFileName: String; +begin + Result:=nil; + ConfFileName:=SetDirSeparators(GetPrimaryConfigPath+'/condef.xml'); + try + if (not FileExistsUTF8(ConfFileName)) then + Result:=TXMLConfig.CreateClean(ConfFileName) + else + Result:=TXMLConfig.Create(ConfFileName); + except + on E: Exception do begin + debugln('TCondForm.CreateXMLConfig ',E.Message); + end; + end; +end; + end.