mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-05 15:37:50 +02:00
460 lines
13 KiB
ObjectPascal
460 lines
13 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
encloseifdef.pas - Conditional Defines
|
|
----------------------------------------
|
|
|
|
***************************************************************************/
|
|
|
|
***************************************************************************
|
|
* *
|
|
* 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 <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
|
|
* *
|
|
***************************************************************************
|
|
}
|
|
unit EncloseIfDef;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
(* Utility to assist in inserting conditional defines. For example, to convert
|
|
OnCreate := @CreateHandler
|
|
to:
|
|
OnCreate := {$IFDEF FPC} @ {$ENDIF} CreateHandler
|
|
select @ and then use Edit, Insert $IFDEF (default shortcut Ctrl+Shift+D),
|
|
select "FPC,NONE" and hit return. If you select one or more complete lines
|
|
then the conditional defines are put on sepearate lines as in:
|
|
{$IFDEF DEBUG}
|
|
Writeln('State= ', State)
|
|
{$ENDIF}
|
|
The choices are listed in abbreviated form so:
|
|
MSWINDOWS,UNIX => {$IFDEF MSWINDOWS} ... {$ENDIF} {$IFDEF UNIX} ... {$ENDIF}
|
|
FPC,ELSE => {$IFDEF FPC} ... {$ELSE} ... {$ENDIF}
|
|
DEBUG,NONE => {$IFDEF DEBUG} ... {$ENDIF}
|
|
This tool is most useful when you need to put several identical conditionals
|
|
in a file, You can add to the possible conditionals by selecting or typing
|
|
the required symbols in "First test" and /or "Second test" and using the
|
|
Add button. Your additons are saved in the encloseifdef.xml file in the lazarus
|
|
configuration directory.
|
|
*)
|
|
|
|
uses
|
|
Classes, SysUtils,
|
|
// LCL
|
|
Controls, Forms, StdCtrls, Buttons, ButtonPanel, LCLType,
|
|
// LazUtils
|
|
LazFileUtils, Laz2_XMLCfg, LazFileCache, LazLoggerBase,
|
|
// IdeIntf
|
|
IDEHelpIntf, IDEImagesIntf, IdeIntfStrConsts,
|
|
// IdeConfig
|
|
LazConf, EnvironmentOpts,
|
|
// IDE
|
|
LazarusIDEStrConsts;
|
|
|
|
type
|
|
|
|
{ TEncloseIfDefForm }
|
|
|
|
TEncloseIfDefForm = class(TForm)
|
|
AddBtn: TBitBtn;
|
|
AddInverse: TBitBtn;
|
|
ButtonPanel1: TButtonPanel;
|
|
FirstLabel: TLabel;
|
|
FirstTest: TComboBox;
|
|
ListBox: TListBox;
|
|
NewTestGroupBox: TGroupBox;
|
|
RemoveBtn: TBitBtn;
|
|
SecondLabel: TLabel;
|
|
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 CondFormCREATE(Sender: TObject);
|
|
procedure ListBoxClick(Sender: TObject);
|
|
procedure ListBoxDblClick(Sender: TObject);
|
|
procedure RemoveBtnClick(Sender: TObject);
|
|
procedure ListBoxKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
|
|
procedure FormShow(Sender: TObject);
|
|
private
|
|
StoredChoice, StoredFirst, StoredSecond: string;
|
|
FS: string;
|
|
function SplitActiveRow(out aFirst, aSecond: string): Boolean;
|
|
procedure DeleteSelected;
|
|
procedure UpdateButtons;
|
|
function IsChanged: Boolean;
|
|
procedure SaveIfChanged;
|
|
function CreateXMLConfig: TXMLConfig;
|
|
end;
|
|
|
|
|
|
function EncloseInsideIFDEF(Text: string; IsPascal: Boolean):string;
|
|
|
|
implementation
|
|
|
|
{$R *.lfm}
|
|
|
|
const
|
|
XmlRoot = 'encloseifdef/';
|
|
|
|
function ShowEncloseIfDefDlg: string;
|
|
var
|
|
EncloseIfDefForm: TEncloseIfDefForm;
|
|
begin
|
|
Result := '';
|
|
EncloseIfDefForm := TEncloseIfDefForm.Create(nil);
|
|
try
|
|
EncloseIfDefForm.ActiveControl := EncloseIfDefForm.ListBox;
|
|
if EncloseIfDefForm.ShowModal = mrOK then
|
|
Result := EncloseIfDefForm.FS;
|
|
finally
|
|
EncloseIfDefForm.Free;
|
|
end
|
|
end;
|
|
|
|
function EncloseInsideIFDEF(Text: string; IsPascal: Boolean):string;
|
|
var
|
|
cond, s, f: string;
|
|
p, p1: Integer;
|
|
IsElse, IsTwo, HasNewline: Boolean;
|
|
Tail, Indent: string;
|
|
|
|
function ifdef(s:string):string;
|
|
begin
|
|
Result :='';
|
|
if (s <>'') and (s[1] = '!') then begin
|
|
if IsPascal then
|
|
Result := 'N'
|
|
else
|
|
Result := 'n';
|
|
s := Copy(s,2,Length(s)-1);
|
|
end;
|
|
if IsPascal then
|
|
Result := '{$IF' + Result + 'DEF ' + s + '}'
|
|
else
|
|
Result := '#if' + Result + 'def ' + s;
|
|
end;
|
|
|
|
begin
|
|
Result := Text;
|
|
cond := ShowEncloseIfDefDlg;
|
|
p := Pos(',',cond);
|
|
if p <= 0 then Exit;
|
|
f := Copy(Cond, 1, p-1);
|
|
s := Copy(Cond, p+1, Length(Cond));
|
|
IsElse := CompareText(s, 'ELSE') = 0;
|
|
IsTwo := CompareText(s, 'NONE') <> 0;
|
|
HasNewline := Pos(#10, Text) > 0;
|
|
if HasNewline then begin
|
|
p := 1;
|
|
{ leave leading newlines unchanged (outside $IFDEF) }
|
|
while (p <= Length(Text)) and (Text[p] in [#10,#13]) do Inc(p);
|
|
Result := Copy(Text,1,p-1);
|
|
p1 := p;
|
|
{ Work out current indentation, to line up $IFDEFS }
|
|
while (p <= Length(Text)) and (Text[p] in [#9,' ']) do Inc(p);
|
|
Indent := Copy(Text, p1, p-p1);
|
|
Text := Copy(Text,p,Length(Text));
|
|
p := Length(Text);
|
|
{ Tailing whitespace is left outside $IFDEF }
|
|
while (p>0) and (Text[p] in [' ',#9,#10,#13]) do Dec(p);
|
|
Tail := Copy(Text, p+1, Length(Text));
|
|
SetLength(Text,p);
|
|
end else begin
|
|
Result := '';
|
|
Tail := '';
|
|
Indent := '';
|
|
end;
|
|
if IsPascal then begin
|
|
f := ifdef(f);
|
|
s := ifdef(s);
|
|
if HasNewline then begin
|
|
Result := Result + Indent + f + LineEnding + Indent + Text + LineEnding;
|
|
if IsElse then
|
|
Result := Result + Indent + '{$ELSE}' + LineEnding
|
|
else begin
|
|
Result := Result + Indent + '{$ENDIF}';
|
|
if IsTwo then
|
|
Result := Result + LineEnding + Indent + s + LineEnding;
|
|
end;
|
|
if IsTwo then
|
|
Result := Result + Indent + Text + LineEnding + Indent + '{$ENDIF}';
|
|
Result := Result + Tail;
|
|
end else begin
|
|
Result := Result + f + ' ' + Text;
|
|
if IsElse then
|
|
Result := Result + ' {$ELSE} '
|
|
else begin
|
|
Result := Result + ' {$ENDIF}';
|
|
if IsTwo then
|
|
Result := Result + ' ' + s + ' ';
|
|
end;
|
|
if IsTwo then
|
|
Result := Result + Text + ' {$ENDIF}';
|
|
end;
|
|
end else begin
|
|
Result := Result + ifdef(f) + LineEnding + indent + Text + LineEnding;
|
|
if IsElse then
|
|
Result := Result + '#else' + LineEnding
|
|
else begin
|
|
Result := Result + '#endif /* ' + f + ' */' + LineEnding;
|
|
if IsTwo then
|
|
Result := Result + ifdef(s) + LineEnding;
|
|
end;
|
|
if IsTwo then begin
|
|
Result := Result + indent + Text + LineEnding + '#endif /* ';
|
|
if IsElse then
|
|
Result := Result + f
|
|
else
|
|
Result := Result + s;
|
|
Result := Result + ' */' + LineEnding;
|
|
end;
|
|
Result := Result + Tail;
|
|
end;
|
|
end;
|
|
|
|
{ TEncloseIfDefForm }
|
|
|
|
procedure TEncloseIfDefForm.CondFormCREATE(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
XMLConfig: TXMLConfig;
|
|
begin
|
|
NewTestGroupBox.Caption := rsCreateNewDefine;
|
|
Caption := rsConditionalDefines;
|
|
FirstLabel.Caption := lisFirstTest;
|
|
SecondLabel.Caption := lisSecondTest;
|
|
AddBtn.Caption := lisBtnAdd;
|
|
IDEImages.AssignImage(AddBtn, 'laz_add');
|
|
AddInverse.Caption := rsAddInverse;
|
|
IDEImages.AssignImage(AddInverse, 'pkg_issues');
|
|
RemoveBtn.Caption := lisBtnRemove;
|
|
IDEImages.AssignImage(RemoveBtn, 'laz_delete');
|
|
ButtonPanel1.CloseButton.Caption := lisSave;
|
|
ButtonPanel1.OKButton.Caption := lisOk;
|
|
//ButtonPanel1.CloseButton.LoadGlyphFromResource(idButtonSave);
|
|
//if btnSave.Glyph.Empty then
|
|
// btnSave.LoadGlyphFromResourceName(HInstance, 'laz_save');
|
|
try
|
|
XMLConfig:=CreateXMLConfig;
|
|
try
|
|
StoredChoice := XMLConfig.GetValue(XmlRoot + 'Choice',
|
|
'"MSWINDOWS,UNIX","MSWINDOWS,ELSE","FPC,NONE","FPC,ELSE","DEBUG,NONE"');
|
|
StoredFirst := XMLConfig.GetValue(XmlRoot + 'First', 'MSWINDOWS');
|
|
StoredSecond := XMLConfig.GetValue(XmlRoot + '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;
|
|
FirstTest.DropDownCount := EnvironmentOptions.DropDownCount;
|
|
SecondTest.DropDownCount := EnvironmentOptions.DropDownCount;
|
|
end;
|
|
|
|
procedure TEncloseIfDefForm.FormShow(Sender: TObject);
|
|
begin
|
|
if SecondTest.Items.Count < 10 then
|
|
SecondTest.Items.AddStrings(FirstTest.Items);
|
|
ListBoxClick(Nil);
|
|
end;
|
|
|
|
function TEncloseIfDefForm.SplitActiveRow(out 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 TEncloseIfDefForm.AddBtnClick(Sender: TObject);
|
|
begin
|
|
ListBox.Items.Add(FirstTest.Text+','+SecondTest.Text);
|
|
ListBox.ItemIndex := ListBox.Items.Count-1;
|
|
UpdateButtons;
|
|
end;
|
|
|
|
procedure TEncloseIfDefForm.AddInverseCLICK(Sender: TObject);
|
|
begin
|
|
ListBox.Items.Add('!'+FirstTest.Text+','+SecondTest.Text);
|
|
ListBox.ItemIndex := ListBox.Items.Count-1;
|
|
UpdateButtons;
|
|
end;
|
|
|
|
procedure TEncloseIfDefForm.TestEditChange(Sender: TObject);
|
|
begin
|
|
UpdateButtons;
|
|
end;
|
|
|
|
procedure TEncloseIfDefForm.btnSaveClick(Sender: TObject);
|
|
begin
|
|
SaveIfChanged;
|
|
Close;
|
|
end;
|
|
|
|
procedure TEncloseIfDefForm.OKButtonClick(Sender: TObject);
|
|
begin
|
|
SaveIfChanged;
|
|
with ListBox do
|
|
FS := Items[ItemIndex]; // Return selected row to caller.
|
|
end;
|
|
|
|
procedure TEncloseIfDefForm.HelpButtonClick(Sender: TObject);
|
|
begin
|
|
LazarusHelp.ShowHelpForIDEControl(Self);
|
|
end;
|
|
|
|
procedure TEncloseIfDefForm.ListBoxClick(Sender: TObject);
|
|
var
|
|
ff, ss: string;
|
|
begin
|
|
if SplitActiveRow(ff, ss) then begin
|
|
FirstTest.Text := ff;
|
|
SecondTest.Text := ss;
|
|
UpdateButtons;
|
|
end;
|
|
end;
|
|
|
|
procedure TEncloseIfDefForm.ListBoxDblClick(Sender: TObject);
|
|
begin
|
|
ModalResult := mrOK;
|
|
end;
|
|
|
|
procedure TEncloseIfDefForm.RemoveBtnClick(Sender: TObject);
|
|
begin
|
|
DeleteSelected;
|
|
end;
|
|
|
|
procedure TEncloseIfDefForm.ListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if Key = VK_DELETE then begin
|
|
DeleteSelected;
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TEncloseIfDefForm.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 TEncloseIfDefForm.UpdateButtons;
|
|
var
|
|
s: string;
|
|
begin
|
|
s := FirstTest.Text+','+SecondTest.Text;
|
|
AddBtn.Enabled := (FirstTest.Text <> '') and (ListBox.Items.IndexOf(s) = -1);
|
|
s := '!' + s;
|
|
AddInverse.Enabled := (FirstTest.Text <> '')
|
|
and (FirstTest.Text[1] <> '!')
|
|
and (ListBox.Items.IndexOf(s) = -1);
|
|
RemoveBtn.Enabled := ListBox.SelCount > 0;
|
|
ButtonPanel1.CloseButton.Enabled := IsChanged;
|
|
ButtonPanel1.OKButton.Enabled := ListBox.SelCount > 0;
|
|
end;
|
|
|
|
function TEncloseIfDefForm.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 TEncloseIfDefForm.SaveIfChanged;
|
|
var
|
|
ff, ss: string;
|
|
XMLConfig: TXMLConfig;
|
|
begin
|
|
if ButtonPanel1.CloseButton.Enabled then // enabled only if there are changes
|
|
try
|
|
SplitActiveRow(ff, ss);
|
|
InvalidateFileStateCache;
|
|
XMLConfig:=CreateXMLConfig;
|
|
try
|
|
XMLConfig.SetValue(XmlRoot + 'Choice', ListBox.Items.CommaText);
|
|
XMLConfig.SetValue(XmlRoot + 'First', ff);
|
|
XMLConfig.SetValue(XmlRoot + 'Second', ss);
|
|
XMLConfig.Flush;
|
|
finally
|
|
XMLConfig.Free;
|
|
end;
|
|
except
|
|
on E: Exception do begin
|
|
debugln('TCondForm.SaveIfChanged ',E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TEncloseIfDefForm.CreateXMLConfig: TXMLConfig;
|
|
var
|
|
ConfFileName: String;
|
|
begin
|
|
Result:=nil;
|
|
ConfFileName:=AppendPathDelim(GetPrimaryConfigPath)+'encloseifdef.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.
|