paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-26 20:04:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: added external tools

Browse Source 
git-svn-id: trunk@401 -
This commit is contained in:
lazarus 2001-11-09 18:15:23 +00:00
parent aeb18d8c38
commit c40ded672a
8 changed files with 1591 additions and 148 deletions

3
.gitattributes vendored
View File

@ -99,6 +99,8 @@ ide/compreg.pp svneol=native#text/pascal
ide/customformeditor.pp svneol=native#text/pascal
ide/editoroptions.pp svneol=native#text/pascal
ide/environmentopts.pp svneol=native#text/pascal
ide/exttooldialog.pas svneol=native#text/pascal
ide/exttooleditdlg.pas svneol=native#text/pascal
ide/findinfilesdlg.pas svneol=native#text/pascal
ide/findreplacedialog.pp svneol=native#text/pascal
ide/formeditor.pp svneol=native#text/pascal
@ -118,6 +120,7 @@ ide/lazarus.rc svneol=native#text/plain
ide/lazarus_dci.lrs svneol=native#text/pascal
ide/lazconf.pp svneol=native#text/pascal
ide/lazres.pp svneol=native#text/pascal
ide/macropromptdlg.pas svneol=native#text/pascal
ide/main.pp svneol=native#text/pascal
ide/msgview.pp svneol=native#text/pascal
ide/newprojectdlg.pp svneol=native#text/pascal

69
ide/environmentopts.pp
View File

@ -1,4 +1,13 @@
{
/***************************************************************************
* *
* This program 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. *
* *
***************************************************************************/
Author: Mattias Gaertner
Abstract:
@ -16,7 +25,7 @@ interface
uses
Classes, SysUtils, Forms, Controls, Buttons, XMLCfg, ObjectInspector,
ExtCtrls, StdCtrls, EditorOptions, LResources, LazConf, Dialogs;
ExtCtrls, StdCtrls, EditorOptions, LResources, LazConf, Dialogs, ExtToolDialog;
const
EnvOptsVersion: integer = 101;
@ -61,7 +70,7 @@ type
// windows
FSaveWindowPositions: boolean;
FWindowPositionsValid: boolean; // the following values are valid
FWindowPositionsValid: boolean; // = the following values are valid
FMainWindowBounds: TRect;
FSourceEditorBounds: TRect;
FMessagesViewBoundsValid: boolean;
@ -98,6 +107,9 @@ type
// backup
FBackupInfoProjectFiles: TBackupInfo;
FBackupInfoOtherFiles: TBackupInfo;
// external tools
fExternalTools: TExternalToolList;
procedure SetFileName(const NewFilename: string);
procedure AddToRecentList(const AFilename: string; RecentList: TStringList;
@ -183,6 +195,10 @@ type
read FBackupInfoProjectFiles write FBackupInfoProjectFiles;
property BackupInfoOtherFiles: TBackupInfo
read FBackupInfoOtherFiles write FBackupInfoOtherFiles;
// external tools
property ExternalTools: TExternalToolList
read fExternalTools write fExternalTools;
end;
//----------------------------------------------------------------------------
@ -238,6 +254,24 @@ type
BackgroundColorLabel: TLabel;
BackgroundColorButton: TColorButton;
// Files
MaxRecentOpenFilesLabel: TLabel;
MaxRecentOpenFilesComboBox: TComboBox;
MaxRecentProjectFilesLabel: TLabel;
MaxRecentProjectFilesComboBox: TComboBox;
OpenLastProjectAtStartCheckBox: TCheckBox;
LazarusDirLabel: TLabel;
LazarusDirComboBox: TComboBox;
CompilerPathLabel: TLabel;
CompilerPathComboBox: TComboBox;
FPCSourceDirLabel: TLabel;
FPCSourceDirComboBox: TComboBox;
DebuggerPathLabel: TLabel;
DebuggerPathComboBox: TComboBox;
DebuggerTypeComboBox: TComboBox;
TestBuildDirLabel: TLabel;
TestBuildDirComboBox: TComboBox;
// backup
BackupHelpLabel: TLabel;
BackupProjectGroupBox: TGroupBox;
@ -257,24 +291,6 @@ type
BakOtherSubDirLabel: TLabel;
BakOtherSubDirComboBox: TComboBox;
// Files
MaxRecentOpenFilesLabel: TLabel;
MaxRecentOpenFilesComboBox: TComboBox;
MaxRecentProjectFilesLabel: TLabel;
MaxRecentProjectFilesComboBox: TComboBox;
OpenLastProjectAtStartCheckBox: TCheckBox;
LazarusDirLabel: TLabel;
LazarusDirComboBox: TComboBox;
CompilerPathLabel: TLabel;
CompilerPathComboBox: TComboBox;
FPCSourceDirLabel: TLabel;
FPCSourceDirComboBox: TComboBox;
DebuggerPathLabel: TLabel;
DebuggerPathComboBox: TComboBox;
DebuggerTypeComboBox: TComboBox;
TestBuildDirLabel: TLabel;
TestBuildDirComboBox: TComboBox;
// buttons at bottom
OkButton: TButton;
CancelButton: TButton;
@ -381,10 +397,14 @@ begin
MaxCounter:=3; // for bakCounter
SubDirectory:='';
end;
// external tools
fExternalTools:=TExternalToolList.Create;
end;
destructor TEnvironmentOptions.Destroy;
begin
fExternalTools.Free;
FRecentOpenFiles.Free;
FRecentProjectFiles.Free;
FObjectInspectorOptions.Free;
@ -549,6 +569,9 @@ begin
LoadRecentList(FRecentProjectFiles,'EnvironmentOptions/Recent/ProjectFiles/');
FLastOpenDialogDir:=XMLConfig.GetValue(
'EnvironmentOptions/Recent/LastOpenDialogDir/Value',FLastOpenDialogDir);
// external tools
fExternalTools.Load(XMLConfig,'EnvironmentOptions/ExternalTools/');
XMLConfig.Free;
@ -687,6 +710,9 @@ begin
XMLConfig.SetValue('EnvironmentOptions/Recent/LastOpenDialogDir/Value'
,FLastOpenDialogDir);
// external tools
fExternalTools.Save(XMLConfig,'EnvironmentOptions/ExternalTools/');
XMLConfig.Flush;
XMLConfig.Free;
@ -695,9 +721,10 @@ begin
FObjectInspectorOptions.SaveBounds:=
FSaveWindowPositions and FWindowPositionsValid;
FObjectInspectorOptions.Save;
except
// ToDo
writeln('[TEnvironmentOptions.Load] error writing "',FFilename,'"');
writeln('[TEnvironmentOptions.Save] error writing "',FFilename,'"');
end;
end;

494
ide/exttooldialog.pas Normal file
View File

@ -0,0 +1,494 @@
{
/***************************************************************************
* *
* This program 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. *
* *
***************************************************************************/
Author: Mattias Gaertner
Abstract:
Defines the TExternalToolList which stores the settings of all external
tools. (= Programfilename and parameters)
And provides TExternalToolDlg which is a dialog for editing a
TExternalToolList;
}
unit ExtToolDialog;
{$mode objfpc}
{$H+}
{$I ide.inc}
interface
uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, LCLLinux, Controls, Forms, Buttons, StdCtrls, ComCtrls,
Dialogs, ExtCtrls, LResources, XMLCfg, ExtToolEditDlg, Process, KeyMapping,
TransferMacros;
const
MaxExtTools = ecExtToolLast-ecExtToolFirst+1;
type
{
the storage object for all external tools
}
TExternalToolList = class(TList)
private
function GetToolOpts(Index: integer): TExternalToolOptions;
procedure SetToolOpts(Index: integer; NewTool: TExternalToolOptions);
public
procedure Add(NewTool: TExternalToolOptions);
procedure Assign(Source: TExternalToolList);
constructor Create;
procedure Delete(Index: integer);
destructor Destroy; override;
procedure Clear; override;
procedure Insert(Index: integer; NewTool: TExternalToolOptions);
function Load(XMLConfig: TXMLConfig; const Path: string): TModalResult;
procedure LoadShortCuts(KeyCommandRelationList: TKeyCommandRelationList);
function Run(Index: integer; Macros: TTransferMacroList): TModalResult;
function Save(XMLConfig: TXMLConfig; const Path: string): TModalResult;
procedure SaveShortCuts(KeyCommandRelationList: TKeyCommandRelationList);
property Items[Index: integer]: TExternalToolOptions
read GetToolOpts write SetToolOpts; default;
end;
{
the dialog to edit all external tools
}
TExternalToolDialog = class(TForm)
Listbox: TListbox;
AddButton: TButton;
RemoveButton: TButton;
EditButton: TButton;
MoveUpButton: TButton;
MoveDownButton: TButton;
OkButton: TButton;
CancelButton: TButton;
procedure OkButtonClick(Sender: TObject);
procedure CancelButtonClick(Sender: TObject);
procedure AddButtonClick(Sender: TObject);
procedure RemoveButtonClick(Sender: TObject);
procedure EditButtonClick(Sender: TObject);
procedure MoveUpButtonClick(Sender: TObject);
procedure MoveDownButtonClick(Sender: TObject);
procedure ListboxClick(Sender: TObject);
private
fExtToolList: TExternalToolList;
fTransferMacros: TTransferMacroList;
procedure Load;
procedure SetExtToolList(NewExtToolList: TExternalToolList);
procedure SetTransferMacros(NewMacros: TTransferMacroList);
function ToolDescription(Index: integer): string;
procedure EnableButtons;
public
constructor Create(AnOwner: TComponent); override;
destructor Destroy; override;
property ExtToolList: TExternalToolList
read fExtToolList write SetExtToolList;
property TransferMacros: TTransferMacroList
read fTransferMacros write SetTransferMacros;
end;
function ShowExtToolDialog(ExtToolList: TExternalToolList;
TransferMacros: TTransferMacroList):TModalResult;
implementation
function ShowExtToolDialog(ExtToolList: TExternalToolList;
TransferMacros: TTransferMacroList):TModalResult;
var ExternalToolDialog: TExternalToolDialog;
begin
Result:=mrCancel;
ExternalToolDialog:=TExternalToolDialog.Create(Application);
try
ExternalToolDialog.TransferMacros:=TransferMacros;
ExternalToolDialog.ExtToolList:=ExtToolList;
Result:=ExternalToolDialog.ShowModal;
if Result=mrOk then
ExtToolList.Assign(ExternalToolDialog.ExtToolList);
finally
ExternalToolDialog.Free;
end;
end;
{ TExternalToolList }
function TExternalToolList.GetToolOpts(Index: integer): TExternalToolOptions;
begin
Result:=TExternalToolOptions(inherited Items[Index]);
end;
procedure TExternalToolList.SetToolOpts(Index: integer;
NewTool: TExternalToolOptions);
begin
inherited Items[Index]:=NewTool;
end;
procedure TExternalToolList.Add(NewTool: TExternalToolOptions);
begin
inherited Add(NewTool);
end;
procedure TExternalToolList.Assign(Source: TExternalToolList);
var i: integer;
begin
if Source=Self then exit;
Clear;
if Source=nil then exit;
Count:=Source.Count;
for i:=0 to Count-1 do begin
Items[i]:=TExternalToolOptions.Create;
Items[i].Assign(Source[i]);
end;
end;
constructor TExternalToolList.Create;
begin
inherited Create;
Clear;
end;
procedure TExternalToolList.Delete(Index: integer);
begin
Items[Index].Free;
inherited Delete(Index);
end;
destructor TExternalToolList.Destroy;
begin
inherited Destroy;
end;
procedure TExternalToolList.Clear;
var i: integer;
begin
for i:=0 to Count-1 do
TExternalToolOptions(Items[i]).Free;
inherited Clear;
end;
procedure TExternalToolList.Insert(Index: integer;
NewTool: TExternalToolOptions);
begin
inherited Insert(Index,NewTool);
end;
function TExternalToolList.Load(XMLConfig: TXMLConfig;
const Path: string): TModalResult;
var i: integer;
NewTool: TExternalToolOptions;
begin
Clear;
Count:=XMLConfig.GetValue(Path+'Count',0);
for i:=0 to Count-1 do begin
NewTool:=TExternalToolOptions.Create;
Items[i]:=NewTool;
if NewTool.Load(XMLConfig,Path+'Tool'+IntToStr(i+1)+'/')<>mrOk then exit;
end;
Result:=mrOk;
end;
procedure TExternalToolList.LoadShortCuts(
KeyCommandRelationList: TKeyCommandRelationList);
var i: integer;
KeyCommandRelation: TKeyCommandRelation;
begin
for i:=0 to Count-1 do begin
KeyCommandRelation:=KeyCommandRelationList.FindByCommand(ecExtToolFirst+i);
if KeyCommandRelation<>nil then begin
Items[i].Key:=KeyCommandRelation.Key1;
Items[i].Shift:=KeyCommandRelation.Shift1;
end else begin
Items[i].Key:=VK_UNKNOWN;
Items[i].Shift:=[];
end;
end;
end;
function TExternalToolList.Run(Index: integer;
Macros: TTransferMacroList): TModalResult;
var WorkingDir, Filename, Params: string;
TheProcess: TProcess;
begin
Result:=mrCancel;
if (Index<0) or (Index>=Count) then exit;
Filename:=Items[Index].Filename;
WorkingDir:=Items[Index].WorkingDirectory;
Params:=Items[Index].CmdLineParams;
if Macros.SubstituteStr(Filename)
and Macros.SubstituteStr(WorkingDir)
and Macros.SubstituteStr(Params) then begin
writeln('[TExternalToolList.Run] ',Filename,' ',Params);
try
TheProcess := TProcess.Create(nil);
TheProcess.CommandLine := Filename+' '+Params;
TheProcess.Options:= [poRunSuspended, poUsePipes, poNoConsole];
TheProcess.ShowWindow := swoNone;
TheProcess.CurrentDirectory := WorkingDir;
TheProcess.Execute;
except
writeln('[TExternalToolList.Run] Failed to run: ',Filename,' ',Params);
end;
end;
Result:=mrOk;
end;
function TExternalToolList.Save(XMLConfig: TXMLConfig;
const Path: string): TModalResult;
var i: integer;
begin
XMLConfig.SetValue(Path+'Count',Count);
for i:=0 to Count-1 do begin
if Items[i].Save(XMLConfig,Path+'Tool'+IntToStr(i+1)+'/')<>mrOk then exit;
end;
Result:=mrOk;
end;
procedure TExternalToolList.SaveShortCuts(
KeyCommandRelationList: TKeyCommandRelationList);
var i: integer;
KeyCommandRelation: TKeyCommandRelation;
begin
KeyCommandRelationList.ExtToolCount:=Count;
for i:=0 to Count-1 do begin
KeyCommandRelation:=KeyCommandRelationList.FindByCommand(ecExtToolFirst+i);
if KeyCommandRelation<>nil then begin
KeyCommandRelation.Key1:=Items[i].Key;
KeyCommandRelation.Shift1:=Items[i].Shift;
end else begin
writeln('[TExternalToolList.SaveShortCuts] Error: '
+'unable to save shortcut for external tool "',Items[i].Title,'"');
end;
end;
end;
{ TExternalToolDialog }
constructor TExternalToolDialog.Create(AnOwner: TComponent);
begin
inherited Create(AnOwner);
if LazarusResources.Find(ClassName)=nil then begin
Caption:='External Tools';
SetBounds((Screen.Width-400) div 2,(Screen.Height-400) div 2,400,400);
Listbox:=TListbox.Create(Self);
with Listbox do begin
Name:='Listbox';
Parent:=Self;
SetBounds(5,5,Self.ClientWidth-120,Self.Clientheight-60);
OnClick:=@ListboxClick;
Visible:=true;
end;
AddButton:=TButton.Create(Self);
with AddButton do begin
Name:='AddButton';
Parent:=Self;
SetBounds(Self.ClientWidth-100,5,80,25);
Caption:='Add';
OnClick:=@AddButtonClick;
Visible:=true;
end;
RemoveButton:=TButton.Create(Self);
with RemoveButton do begin
Name:='RemoveButton';
Parent:=Self;
SetBounds(Self.ClientWidth-100,AddButton.Top+AddButton.Height+10,80,25);
Caption:='Remove';
OnClick:=@RemoveButtonClick;
Visible:=true;
end;
EditButton:=TButton.Create(Self);
with EditButton do begin
Name:='EditButton';
Parent:=Self;
SetBounds(Self.ClientWidth-100,RemoveButton.Top+RemoveButton.Height+10,
80,25);
Caption:='Edit';
OnClick:=@EditButtonClick;
Visible:=true;
end;
MoveUpButton:=TButton.Create(Self);
with MoveUpButton do begin
Name:='MoveUpButton';
Parent:=Self;
SetBounds(Self.ClientWidth-100,EditButton.Top+EditButton.Height+50,
80,25);
Caption:='Move Up';
OnClick:=@MoveUpButtonClick;
Visible:=true;
end;
MoveDownButton:=TButton.Create(Self);
with MoveDownButton do begin
Name:='MoveDownButton';
Parent:=Self;
SetBounds(Self.ClientWidth-100,MoveUpButton.Top+MoveUpButton.Height+10,
80,25);
Caption:='Move Down';
OnClick:=@MoveDownButtonClick;
Visible:=true;
end;
OkButton:=TButton.Create(Self);
with OkButton do begin
Name:='OkButton';
Parent:=Self;
SetBounds(Self.ClientWidth-200, Self.ClientHeight-40,80,25);
Caption:='Ok';
OnClick:=@OkButtonClick;
Visible:=true;
end;
CancelButton:=TButton.Create(Self);
with CancelButton do begin
Name:='CancelButton';
Parent:=Self;
SetBounds(Self.ClientWidth-100, Self.ClientHeight-40,80,25);
Caption:='Cancel';
OnClick:=@CancelButtonClick;
Visible:=true;
end;
end;
fExtToolList:=TExternalToolList.Create;
end;
destructor TExternalToolDialog.Destroy;
begin
fExtToolList.Free;
inherited Destroy;
end;
procedure TExternalToolDialog.OkButtonClick(Sender: TObject);
begin
ModalResult:=mrOk;
end;
procedure TExternalToolDialog.CancelButtonClick(Sender: TObject);
begin
ModalResult:=mrCancel;
end;
procedure TExternalToolDialog.SetExtToolList(NewExtToolList: TExternalToolList);
begin
if fExtToolList=NewExtToolList then exit;
fExtToolList.Assign(NewExtToolList);
Load;
end;
procedure TExternalToolDialog.SetTransferMacros(NewMacros: TTransferMacroList);
begin
if fTransferMacros=NewMacros then exit;
fTransferMacros:=NewMacros;
end;
function TExternalToolDialog.ToolDescription(Index: integer): string;
begin
Result:=fExtToolList[Index].ShortDescription;
end;
procedure TExternalToolDialog.Load;
var i: integer;
begin
Listbox.Items.BeginUpdate;
Listbox.Items.Clear;
for i:=0 to fExtToolList.Count-1 do
Listbox.Items.Add(ToolDescription(i));
Listbox.Items.EndUpdate;
EnableButtons;
end;
procedure TExternalToolDialog.AddButtonClick(Sender: TObject);
var NewTool: TExternalToolOptions;
begin
if fExtToolList.Count>=MaxExtTools then begin
MessageDlg('Maximum Tools reached',
'There is a maximum of '+IntToStr(MaxExtTools)+' tools.',
mtInformation,[mbCancel],0);
exit;
end;
NewTool:=TExternalToolOptions.Create;
if ShowExtToolOptionDlg(fTransferMacros,NewTool)=mrOk then begin
fExtToolList.Add(NewTool);
Listbox.Items.Add(ToolDescription(fExtToolList.Count-1));
end else begin
NewTool.Free;
end;
EnableButtons;
end;
procedure TExternalToolDialog.RemoveButtonClick(Sender: TObject);
begin
if Listbox.ItemIndex<0 then exit;
fExtToolList.Delete(Listbox.ItemIndex);
ListBox.Items.Delete(Listbox.ItemIndex);
EnableButtons;
end;
procedure TExternalToolDialog.EditButtonClick(Sender: TObject);
begin
if Listbox.ItemIndex<0 then exit;
if ShowExtToolOptionDlg(fTransferMacros,fExtToolList[Listbox.ItemIndex])=mrOk
then begin
Listbox.Items[Listbox.ItemIndex]:=ToolDescription(Listbox.ItemIndex);
EnableButtons;
end;
end;
procedure TExternalToolDialog.MoveUpButtonClick(Sender: TObject);
var i: integer;
begin
i:=Listbox.ItemIndex;
if i<1 then exit;
fExtToolList.Move(i,i-1);
Listbox.Items.Move(i,i-1);
Listbox.ItemIndex:=i-1;
EnableButtons;
end;
procedure TExternalToolDialog.MoveDownButtonClick(Sender: TObject);
var i: integer;
begin
i:=Listbox.ItemIndex;
if (i<0) or (i>=Listbox.Items.Count-1) then exit;
fExtToolList.Move(i,i+1);
Listbox.Items.Move(i,i+1);
Listbox.ItemIndex:=i+1;
EnableButtons;
end;
procedure TExternalToolDialog.EnableButtons;
var i: integer;
begin
i:=Listbox.ItemIndex;
AddButton.Enabled:=fExtToolList.Count<MaxExtTools;
RemoveButton.Enabled:=(i>=0);
EditButton.Enabled:=(i>=0);
MoveUpButton.Enabled:=(i>0);
MoveDownButton.Enabled:=(i>=0) and (i<fExtToolList.Count-1);
end;
procedure TExternalToolDialog.ListboxClick(Sender: TObject);
begin
EnableButtons;
end;
end.

610
ide/exttooleditdlg.pas Normal file
View File

@ -0,0 +1,610 @@
{
/***************************************************************************
* *
* This program 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. *
* *
***************************************************************************/
Author: Mattias Gaertner
Abstract:
Defines the TExternalToolOptions which stores the settings of a single
external tool. (= Programfilename and parameters)
All TExternalToolOptions are stored in a TExternalToolList
(see exttooldialog.pas).
And provides TExternalToolOptionDlg which is a dialog for editing a
TExternalToolOptions;
}
unit ExtToolEditDlg;
{$mode objfpc}
{$H+}
{$I ide.inc}
interface
uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, LCLLinux, Controls, Forms, Buttons, StdCtrls, ComCtrls,
Dialogs, ExtCtrls, LResources, XMLCfg, KeyMapping, TransferMacros;
{ The xml format version:
When the format changes (new values, changed formats) we can distinguish old
files and are able to convert them.
}
const ExternalToolOptionsFormat = '1.0';
type
{
the storage object for a single external tool
}
TExternalToolOptions = class
private
fTitle: string;
fFilename: string;
fCmdLineParams: string;
fWorkingDirectory: string;
fKey: word;
fShift: TShiftState;
public
procedure Assign(Source: TExternalToolOptions);
constructor Create;
destructor Destroy; override;
procedure Clear;
function Load(XMLConfig: TXMLConfig; const Path: string): TModalResult;
function Save(XMLConfig: TXMLConfig; const Path: string): TModalResult;
function ShortDescription: string;
property Title: string read fTitle write fTitle;
property Filename: string read fFilename write fFilename;
property CmdLineParams: string read fCmdLineParams write fCmdLineParams;
property WorkingDirectory: string
read fWorkingDirectory write fWorkingDirectory;
property Key: word read fKey write fKey;
property Shift: TShiftState read fShift write fShift;
end;
{
the editor dialog for a single external tool
}
TExternalToolOptionDlg = class(TForm)
TitleLabel: TLabel;
TitleEdit: TEdit;
FilenameLabel: TLabel;
FilenameEdit: TEdit;
ParametersLabel: TLabel;
ParametersEdit: TEdit;
WorkingDirLabel: TLabel;
WorkingDirEdit: TEdit;
KeyGroupBox: TGroupBox;
KeyCtrlCheckBox: TCheckBox;
KeyAltCheckBox: TCheckBox;
KeyShiftCheckBox: TCheckBox;
KeyComboBox: TComboBox;
KeyGrabButton: TButton;
MacrosGroupbox: TGroupbox;
MacrosListbox: TListbox;
MacrosInsert: TButton;
OkButton: TButton;
CancelButton: TButton;
procedure CancelButtonClick(Sender: TObject);
procedure OkButtonClick(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word; Shift:TShiftState);
procedure KeyGrabButtonClick(Sender: TObject);
procedure MacrosInsertClick(Sender: TObject);
private
fOptions: TExternalToolOptions;
fTransferMacros: TTransferMacroList;
GrabbingKey: integer; // 0=none, 1=Default key
procedure ActivateGrabbing(AGrabbingKey: integer);
procedure DeactivateGrabbing;
procedure FillMacroList;
procedure LoadFromOptions;
procedure SaveToOptions;
procedure SetComboBox(AComboBox: TComboBox; const AValue: string);
procedure SetOptions(TheOptions: TExternalToolOptions);
procedure SetTransferMacros(TransferMacroList: TTransferMacroList);
public
constructor Create(AnOwner: TComponent); override;
destructor Destroy; override;
property Options: TExternalToolOptions read fOptions write SetOptions;
property MacroList: TTransferMacroList
read fTransferMacros write SetTransferMacros;
end;
function ShowExtToolOptionDlg(TransferMacroList: TTransferMacroList;
ExternalToolOptions: TExternalToolOptions):TModalResult;
implementation
function ShowExtToolOptionDlg(TransferMacroList: TTransferMacroList;
ExternalToolOptions: TExternalToolOptions):TModalResult;
var ExternalToolOptionDlg: TExternalToolOptionDlg;
begin
Result:=mrCancel;
ExternalToolOptionDlg:=TExternalToolOptionDlg.Create(Application);
try
ExternalToolOptionDlg.Options:=ExternalToolOptions;
ExternalToolOptionDlg.MacroList:=TransferMacroList;
Result:=ExternalToolOptionDlg.ShowModal;
if Result=mrOk then
ExternalToolOptions.Assign(ExternalToolOptionDlg.Options);
finally
ExternalToolOptionDlg.Free;
end;
end;
{ TExternalToolOptions }
procedure TExternalToolOptions.Assign(Source: TExternalToolOptions);
begin
if Source=Self then exit;
if Source=nil then
Clear
else begin
fTitle:=Source.fTitle;
fFilename:=Source.fFilename;
fCmdLineParams:=Source.fCmdLineParams;
fWorkingDirectory:=Source.fWorkingDirectory;
fKey:=Source.fKey;
fShift:=Source.fShift;
end;
end;
constructor TExternalToolOptions.Create;
begin
inherited Create;
Clear;
end;
destructor TExternalToolOptions.Destroy;
begin
inherited Destroy;
end;
procedure TExternalToolOptions.Clear;
begin
fTitle:='';
fFilename:='';
fCmdLineParams:='';
fWorkingDirectory:='';
fKey:=VK_UNKNOWN;
fShift:=[];
end;
function TExternalToolOptions.Load(XMLConfig: TXMLConfig;
const Path: string): TModalResult;
begin
Clear;
fTitle:=XMLConfig.GetValue(Path+'Title/Value',fTitle);
fFilename:=XMLConfig.GetValue(Path+'Filename/Value',fFilename);
fCmdLineParams:=XMLConfig.GetValue(Path+'CmdLineParams/Value',fCmdLineParams);
fWorkingDirectory:=XMLConfig.GetValue(
Path+'WorkingDirectory/Value',fWorkingDirectory);
// key and shift will be saved with the keymapping in the editoroptions
Result:=mrOk;
end;
function TExternalToolOptions.Save(XMLConfig: TXMLConfig;
const Path: string): TModalResult;
begin
XMLConfig.SetValue(Path+'Format/Version',ExternalToolOptionsFormat);
XMLConfig.SetValue(Path+'Title/Value',fTitle);
XMLConfig.SetValue(Path+'Filename/Value',fFilename);
XMLConfig.SetValue(Path+'CmdLineParams/Value',fCmdLineParams);
XMLConfig.SetValue(Path+'WorkingDirectory/Value',fWorkingDirectory);
Result:=mrOk;
end;
function TExternalToolOptions.ShortDescription: string;
begin
Result:=Title;
end;
{ TExternalToolOptionDlg }
constructor TExternalToolOptionDlg.Create(AnOwner: TComponent);
var
i: integer;
s: string;
begin
inherited Create(AnOwner);
GrabbingKey:=0;
if LazarusResources.Find(ClassName)=nil then begin
Caption:='Edit Tool';
SetBounds((Screen.Width-560) div 2,(Screen.Height-450) div 2,560,450);
OnKeyUp:=@FormKeyUp;
TitleLabel:=TLabel.Create(Self);
with TitleLabel do begin
Name:='TitleLabel';
Parent:=Self;
SetBounds(5,5,110,22);
Caption:='Title:';
Visible:=true;
end;
TitleEdit:=TEdit.Create(Self);
with TitleEdit do begin
Name:='TitleEdit';
Parent:=Self;
Left:=TitleLabel.Left+TitleLabel.Width+5;
Top:=TitleLabel.Top+2;
Width:=Self.ClientWidth-Left-10;
Height:=25;
Visible:=true;
end;
FilenameLabel:=TLabel.Create(Self);
with FilenameLabel do begin
Name:='FilenameLabel';
Parent:=Self;
SetBounds(TitleLabel.Left,TitleLabel.Top+TitleLabel.Height+10,
TitleLabel.Width,TitleLabel.Height);
Caption:='Programfilename:';
Visible:=true;
end;
FilenameEdit:=TEdit.Create(Self);
with FilenameEdit do begin
Name:='FilenameEdit';
Parent:=Self;
SetBounds(TitleEdit.Left,FilenameLabel.Top+2,TitleEdit.Width,
TitleEdit.Height);
Visible:=true;
end;
ParametersLabel:=TLabel.Create(Self);
with ParametersLabel do begin
Name:='ParametersLabel';
Parent:=Self;
SetBounds(FilenameLabel.Left,FilenameLabel.Top+FilenameLabel.Height+10,
FilenameLabel.Width,FilenameLabel.Height);
Caption:='Parameters:';
Visible:=true;
end;
ParametersEdit:=TEdit.Create(Self);
with ParametersEdit do begin
Name:='ParametersEdit';
Parent:=Self;
SetBounds(FilenameEdit.Left,ParametersLabel.Top+2,FilenameEdit.Width,
FilenameEdit.Height);
Visible:=true;
end;
WorkingDirLabel:=TLabel.Create(Self);
with WorkingDirLabel do begin
Name:='WorkingDirLabel';
Parent:=Self;
SetBounds(ParametersLabel.Left,
ParametersLabel.Top+ParametersLabel.Height+10,ParametersLabel.Width,
ParametersLabel.Height);
Caption:='Working Directory:';
Visible:=true;
end;
WorkingDirEdit:=TEdit.Create(Self);
with WorkingDirEdit do begin
Name:='WorkingDirEdit';
Parent:=Self;
SetBounds(ParametersEdit.Left,WorkingDirLabel.Top+2,ParametersEdit.Width,
ParametersEdit.Height);
Visible:=true;
end;
KeyGroupBox:=TGroupBox.Create(Self);
with KeyGroupBox do begin
Name:='KeyGroupBox';
Parent:=Self;
Caption:='Key';
Left:=5;
Top:=WorkingDirLabel.Top+WorkingDirLabel.Height+12;
Width:=Self.ClientWidth-Left-Left;
Height:=50;
Show;
end;
KeyCtrlCheckBox:=TCheckBox.Create(Self);
with KeyCtrlCheckBox do begin
Name:='KeyCtrlCheckBox';
Parent:=KeyGroupBox;
Caption:='Ctrl';
Left:=5;
Top:=2;
Width:=50;
Height:=20;
Show;
end;
KeyAltCheckBox:=TCheckBox.Create(Self);
with KeyAltCheckBox do begin
Name:='KeyAltCheckBox';
Parent:=KeyGroupBox;
Caption:='Alt';
Left:=KeyCtrlCheckBox.Left+KeyCtrlCheckBox.Width+10;
Top:=KeyCtrlCheckBox.Top;
Height:=20;
Width:=KeyCtrlCheckBox.Width;
Show;
end;
KeyShiftCheckBox:=TCheckBox.Create(Self);
with KeyShiftCheckBox do begin
Name:='KeyShiftCheckBox';
Parent:=KeyGroupBox;
Caption:='Shift';
Left:=KeyAltCheckBox.Left+KeyAltCheckBox.Width+10;
Top:=KeyCtrlCheckBox.Top;
Height:=20;
Width:=KeyCtrlCheckBox.Width;
Show;
end;
KeyComboBox:=TComboBox.Create(Self);
with KeyComboBox do begin
Name:='KeyComboBox';
Parent:=KeyGroupBox;
Left:=KeyShiftCheckBox.Left+KeyShiftCheckBox.Width+10;
Top:=KeyCtrlCheckBox.Top;
Width:=190;
Items.BeginUpdate;
Items.Add('none');
for i:=1 to 145 do begin
s:=KeyAndShiftStateToStr(i,[]);
if lowercase(copy(s,1,5))<>'word(' then
Items.Add(s);
end;
Items.EndUpdate;
ItemIndex:=0;
Show;
end;
KeyGrabButton:=TButton.Create(Self);
with KeyGrabButton do begin
Parent:=KeyGroupBox;
Left:=KeyComboBox.Left+KeyComboBox.Width+10;
Top:=KeyCtrlCheckBox.Top;
Width:=150;
Height:=25;
Caption:='Grab Key';
Name:='KeyGrabButton';
OnClick:=@KeyGrabButtonClick;
Show;
end;
MacrosGroupbox:=TGroupbox.Create(Self);
with MacrosGroupbox do begin
Name:='MacrosGroupbox';
Parent:=Self;
Left:=KeyGroupBox.Left;
Top:=KeyGroupBox.Top+KeyGroupBox.Height+10;
Width:=KeyGroupBox.Width;
Height:=Self.ClientHeight-50-Top;
Caption:='Macros';
Visible:=true;
end;
MacrosListbox:=TListbox.Create(Self);
with MacrosListbox do begin
Name:='MacrosListbox';
Parent:=MacrosGroupbox;
SetBounds(5,5,MacrosGroupbox.ClientWidth-120,
MacrosGroupbox.ClientHeight-30);
Visible:=true;
end;
MacrosInsert:=TButton.Create(Self);
with MacrosInsert do begin
Name:='MacrosInsert';
Parent:=MacrosGroupbox;
SetBounds(MacrosGroupbox.ClientWidth-90,5,70,25);
Caption:='Insert';
OnClick:=@MacrosInsertClick;
Visible:=true;
end;
OkButton:=TButton.Create(Self);
with OkButton do begin
Name:='OkButton';
Parent:=Self;
SetBounds(270,Self.ClientHeight-40,100,25);
Caption:='Ok';
OnClick:=@OkButtonClick;
Visible:=true;
end;
CancelButton:=TButton.Create(Self);
with CancelButton do begin
Name:='CancelButton';
Parent:=Self;
SetBounds(390,OkButton.Top,100,25);
Caption:='Cancel';
OnClick:=@CancelButtonClick;
Visible:=true;
end;
end;
fOptions:=TExternalToolOptions.Create;
end;
destructor TExternalToolOptionDlg.Destroy;
begin
fOptions.Free;
inherited Destroy;
end;
procedure TExternalToolOptionDlg.SaveToOptions;
begin
fOptions.Title:=TitleEdit.Text;
fOptions.Filename:=FilenameEdit.Text;
fOptions.CmdLineParams:=ParametersEdit.Text;
fOptions.WorkingDirectory:=WorkingDirEdit.Text;
fOptions.Key:=StrToVKCode(KeyComboBox.Text);
fOptions.Shift:=[];
if fOptions.Key<>VK_UNKNOWN then begin
if KeyCtrlCheckBox.Checked then include(fOptions.fShift,ssCtrl);
if KeyAltCheckBox.Checked then include(fOptions.fShift,ssAlt);
if KeyShiftCheckBox.Checked then include(fOptions.fShift,ssShift);
end;
end;
procedure TExternalToolOptionDlg.LoadFromOptions;
begin
TitleEdit.Text:=fOptions.Title;
FilenameEdit.Text:=fOptions.Filename;
ParametersEdit.Text:=fOptions.CmdLineParams;
WorkingDirEdit.Text:=fOptions.WorkingDirectory;
SetComboBox(KeyComboBox,KeyAndShiftStateToStr(fOptions.Key,[]));
KeyCtrlCheckBox.Checked:=(ssCtrl in fOptions.Shift);
KeyShiftCheckBox.Checked:=(ssShift in fOptions.Shift);
KeyAltCheckBox.Checked:=(ssAlt in fOptions.Shift);
end;
procedure TExternalToolOptionDlg.OkButtonClick(Sender: TObject);
begin
if (TitleEdit.Text='') or (FilenameEdit.Text='') then begin
MessageDlg('Title and Filename required',
'A valid tool needs at least a title and a filename.',
mtError, [mbCancel], 0);
exit;
end;
SaveToOptions;
ModalResult:=mrOk;
end;
procedure TExternalToolOptionDlg.CancelButtonClick(Sender: TObject);
begin
ModalResult:=mrCancel;
end;
procedure TExternalToolOptionDlg.KeyGrabButtonClick(Sender: TObject);
begin
ActivateGrabbing(1);
end;
procedure TExternalToolOptionDlg.SetOptions(TheOptions: TExternalToolOptions);
begin
if fOptions=TheOptions then exit;
fOptions.Assign(TheOptions);
LoadFromOptions;
end;
procedure TExternalToolOptionDlg.SetTransferMacros(
TransferMacroList: TTransferMacroList);
begin
if fTransferMacros=TransferMacroList then exit;
fTransferMacros:=TransferMacroList;
if MacrosListbox=nil then exit;
FillMacroList;
end;
procedure TExternalToolOptionDlg.FillMacroList;
var i: integer;
begin
MacrosListbox.Items.BeginUpdate;
MacrosListbox.Items.Clear;
if fTransferMacros<>nil then begin
for i:=0 to fTransferMacros.Count-1 do begin
if fTransferMacros[i].MacroFunction=nil then begin
MacrosListbox.Items.Add('$('+fTransferMacros[i].Name+') - '
+fTransferMacros[i].Description);
end else begin
MacrosListbox.Items.Add('$'+fTransferMacros[i].Name+'() - '
+fTransferMacros[i].Description);
end;
end;
end;
MacrosListbox.Items.EndUpdate;
end;
procedure TExternalToolOptionDlg.SetComboBox(
AComboBox: TComboBox; const AValue: string);
var i: integer;
begin
i:=AComboBox.Items.IndexOf(AValue);
if i>=0 then
AComboBox.ItemIndex:=i
else begin
AComboBox.Items.Add(AValue);
AComboBox.ItemIndex:=AComboBox.Items.IndexOf(AValue);
end;
end;
procedure TExternalToolOptionDlg.DeactivateGrabbing;
var i: integer;
begin
if GrabbingKey=0 then exit;
// enable all components
for i:=0 to ComponentCount-1 do begin
if (Components[i] is TWinControl) then
TWinControl(Components[i]).Enabled:=true;
end;
if GrabbingKey=1 then
KeyGrabButton.Caption:='Grab Key';
GrabbingKey:=0;
end;
procedure TExternalToolOptionDlg.ActivateGrabbing(AGrabbingKey: integer);
var i: integer;
begin
if GrabbingKey>0 then exit;
GrabbingKey:=AGrabbingKey;
if GrabbingKey=0 then exit;
// disable all components
for i:=0 to ComponentCount-1 do begin
if (Components[i] is TWinControl) then begin
if ((GrabbingKey=1) and (Components[i]<>KeyGrabButton)
and (Components[i]<>KeyGroupBox)) then
TWinControl(Components[i]).Enabled:=false;
end;
end;
if GrabbingKey=1 then
KeyGrabButton.Caption:='Please press a key ...'
end;
procedure TExternalToolOptionDlg.FormKeyUp(Sender: TObject; var Key: Word;
Shift:TShiftState);
begin
//writeln('TExternalToolOptionDlg.FormKeyUp Sender=',Classname
// ,' Key=',Key,' Ctrl=',ssCtrl in Shift,' Shift=',ssShift in Shift
// ,' Alt=',ssAlt in Shift,' AsString=',KeyAndShiftStateToStr(Key,Shift)
// );
if Key in [VK_CONTROL, VK_SHIFT, VK_LCONTROL, VK_RCONTROl,
VK_LSHIFT, VK_RSHIFT] then exit;
if (GrabbingKey in [1]) then begin
if GrabbingKey=1 then begin
KeyCtrlCheckBox.Checked:=(ssCtrl in Shift);
KeyShiftCheckBox.Checked:=(ssShift in Shift);
KeyAltCheckBox.Checked:=(ssAlt in Shift);
SetComboBox(KeyComboBox,KeyAndShiftStateToStr(Key,[]));
end;
DeactivateGrabbing;
end;
end;
procedure TExternalToolOptionDlg.MacrosInsertClick(Sender: TObject);
var i: integer;
s: string;
begin
i:=MacrosListbox.ItemIndex;
if i<0 then exit;
if fTransferMacros[i].MacroFunction=nil then
s:='$('+fTransferMacros[i].Name+')'
else
s:='$'+fTransferMacros[i].Name+'()';
ParametersEdit.Text:=ParametersEdit.Text+s;
end;
end.

104
ide/keymapping.pp
View File

@ -1,4 +1,13 @@
{
/***************************************************************************
* *
* This program 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. *
* *
***************************************************************************/
Author: Mattias Gaertner
Abstract:
@ -55,6 +64,9 @@ const
ecJumpToEditor = ecUserFirst + 300;
ecToggleFormUnit = ecUserFirst + 301;
ecExtToolFirst = ecUserFirst + 400;
ecExtToolLast = ecUserFirst + 499;
ecGotoEditor1 = ecUserFirst + 2000;
ecGotoEditor2 = ecGotoEditor1 + 1;
@ -88,14 +100,15 @@ type
// class for a list of key - command relations
TKeyCommandRelationList = class
private
FRelations:TList;
fRelations:TList;
fExtToolCount: integer;
function GetRelation(Index:integer):TKeyCommandRelation;
function Add(Name:shortstring;Command:TSynEditorCommand;
Key1:Word; Shift1:TShiftState;
Key2:Word; Shift2:TShiftState):integer;
function ShiftStateToStr(Shift:TShiftState):AnsiString;
procedure SetExtToolCount(NewCount: integer);
public
property Relations[Index:integer]:TKeyCommandRelation read GetRelation;
function Count:integer;
function Find(AKey:Word; AShiftState:TShiftState):TKeyCommandRelation;
function FindByCommand(ACommand:TSynEditorCommand):TKeyCommandRelation;
@ -104,6 +117,8 @@ type
procedure AssignTo(ASynEditKeyStrokes:TSynEditKeyStrokes);
constructor Create;
destructor Destroy; override;
property ExtToolCount: integer read fExtToolCount write SetExtToolCount;
property Relations[Index:integer]:TKeyCommandRelation read GetRelation;
end;
//---------------------------------------------------------------------------
@ -146,12 +161,25 @@ function ShowKeyMappingEditForm(Index:integer;
function KeyStrokesConsistencyErrors(ASynEditKeyStrokes:TSynEditKeyStrokes;
Protocol: TStrings; var Index1,Index2:integer):integer;
function EditorCommandToDescriptionString(cmd: TSynEditorCommand):AnsiString;
function StrToVKCode(s: string): integer;
var KeyMappingEditForm:TKeyMappingEditForm;
var KeyMappingEditForm: TKeyMappingEditForm;
implementation
function StrToVKCode(s: string): integer;
var i: integer;
begin
if copy(s,1,6)='Word(''' then
Result:=StrToIntDef(copy(s,7,length(s)-8),VK_UNKNOWN)
else if s<>'none' then begin
for i:=1 to 200 do
if KeyAndShiftStateToStr(i,[])=s then
Result:=i;
end else
Result:=VK_UNKNOWN;
end;
function ShowKeyMappingEditForm(Index:integer;
AKeyCommandRelationList:TKeyCommandRelationList):TModalResult;
@ -323,16 +351,18 @@ begin
ecStopProgram: Result:= 'stop program';
ecJumpToEditor: Result:='jump to editor';
ecToggleFormUnit: Result:='toggle between form and unit';
ecGotoEditor1: Result:= 'goto editor 1';
ecGotoEditor2: Result:= 'goto editor 2';
ecGotoEditor3: Result:= 'goto editor 3';
ecGotoEditor4: Result:= 'goto editor 4';
ecGotoEditor5: Result:= 'goto editor 5';
ecGotoEditor6: Result:= 'goto editor 6';
ecGotoEditor7: Result:= 'goto editor 7';
ecGotoEditor8: Result:= 'goto editor 8';
ecGotoEditor9: Result:= 'goto editor 9';
ecGotoEditor0: Result:= 'goto editor 10';
ecGotoEditor1: Result:='goto editor 1';
ecGotoEditor2: Result:='goto editor 2';
ecGotoEditor3: Result:='goto editor 3';
ecGotoEditor4: Result:='goto editor 4';
ecGotoEditor5: Result:='goto editor 5';
ecGotoEditor6: Result:='goto editor 6';
ecGotoEditor7: Result:='goto editor 7';
ecGotoEditor8: Result:='goto editor 8';
ecGotoEditor9: Result:='goto editor 9';
ecGotoEditor0: Result:='goto editor 10';
ecExtToolFirst..ecExtToolLast:
Result:='external tool '+IntToStr(cmd-ecExtToolFirst+1);
else
Result:='unknown editor command';
@ -671,20 +701,6 @@ var NewKey1,NewKey2:integer;
NewShiftState1,NewShiftState2:TShiftState;
ACaption,AText:AnsiString;
DummyRelation:TKeyCommandRelation;
function StrToVKCode(s: string): integer;
var i: integer;
begin
if copy(s,1,6)='Word(''' then
Result:=StrToIntDef(copy(s,7,length(s)-8),VK_UNKNOWN)
else if s<>'none' then begin
for i:=1 to 200 do
if KeyAndShiftStateToStr(i,[])=s then
Result:=i;
end else
Result:=VK_UNKNOWN;
end;
begin
NewKey1:=VK_UNKNOWN;
NewShiftState1:=[];
@ -850,6 +866,7 @@ constructor TKeyCommandRelationList.Create;
begin
inherited Create;
FRelations:=TList.Create;
fExtToolCount:=0;
// normal synedit commands
Add('Select All',ecSelectAll,VK_UNKNOWN,[],VK_UNKNOWN,[]);
@ -964,11 +981,36 @@ begin
,Key1,Shift1,Key2,Shift2));
end;
procedure TKeyCommandRelationList.SetExtToolCount(NewCount: integer);
var i: integer;
begin
if NewCount=fExtToolCount then exit;
if NewCount>fExtToolCount then begin
// increase available external tool commands
while NewCount>fExtToolCount do begin
Add('External tool '+IntToStr(fExtToolCount),
ecExtToolFirst+fExtToolCount,VK_UNKNOWN,[],VK_UNKNOWN,[]);
inc(fExtToolCount);
end;
end else begin
// decrease available external tool commands
i:=Count-1;
while (i>=0) and (fExtToolCount>NewCount) do begin
if (Relations[i].Command>=ecExtToolFirst)
and (Relations[i].Command<=ecExtToolLast) then begin
fRelations.Delete(i);
dec(fExtToolCount);
end;
dec(i);
end;
end;
end;
function TKeyCommandRelationList.LoadFromXMLConfig(
XMLConfig:TXMLConfig; Prefix:AnsiString):boolean;
var a,b,p:integer;
Name:ShortString;
Default,NewValue:AnsiString;
DefaultStr,NewValue:AnsiString;
function ReadNextInt:integer;
begin
@ -992,14 +1034,15 @@ var a,b,p:integer;
// LoadFromXMLConfig
begin
ExtToolCount:=XMLConfig.GetValue(Prefix+'ExternalToolCount/Value',0);
for a:=0 to FRelations.Count-1 do begin
Name:=lowercase(Relations[a].Name);
for b:=1 to length(Name) do
if Name[b]=' ' then Name[b]:='_';
with Relations[a] do
Default:=IntToStr(Key1)+','+ShiftStateToStr(Shift1)
DefaultStr:=IntToStr(Key1)+','+ShiftStateToStr(Shift1)
+','+IntToStr(Key2)+','+ShiftStateToStr(Shift2);
NewValue:=XMLConfig.GetValue(Prefix+Name,Default);
NewValue:=XMLConfig.GetValue(Prefix+Name,DefaultStr);
p:=1;
with Relations[a] do begin
Key1:=ReadNextInt;
@ -1017,6 +1060,7 @@ var a,b:integer;
Name:ShortString;
s:AnsiString;
begin
XMLConfig.SetValue(Prefix+'ExternalToolCount/Value',ExtToolCount);
for a:=0 to FRelations.Count-1 do begin
Name:=lowercase(Relations[a].Name);
for b:=1 to length(Name) do

139
ide/macropromptdlg.pas Normal file
View File

@ -0,0 +1,139 @@
{
/***************************************************************************
* *
* This program 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. *
* *
***************************************************************************/
Author: Mattias Gaertner
Abstract:
A simple dialog for the $PROMPT() tranfer macro function.
}
unit MacroPromptDlg;
{$mode objfpc}
{$H+}
{$I ide.inc}
interface
uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, LCLLinux, Controls, Forms, Buttons, StdCtrls, ComCtrls,
Dialogs, LResources;
type
TMacroPrompDialog = class(TForm)
NoteLabel: TLabel;
DataEdit: TEdit;
OkButton: TButton;
CancelButton: TButton;
procedure OkButtonClick(Sender: TObject);
procedure CancelButtonClick(Sender: TObject);
procedure DataEditKeyDown(Sender: TObject; var Key:Word; Shift:TShiftState);
public
constructor Create(AnOwner: TComponent); override;
end;
function ShowMacroPromptDialog(var InitParam: string): TModalResult;
implementation
function ShowMacroPromptDialog(var InitParam: string): TModalResult;
var MacroPrompDialog: TMacroPrompDialog;
begin
Result:=mrCancel;
MacroPrompDialog:=TMacroPrompDialog.Create(Application);
try
MacroPrompDialog.DataEdit.Text:=InitParam;
Result:=MacroPrompDialog.ShowModal;
if Result=mrOk then
InitParam:=MacroPrompDialog.DataEdit.Text;
finally
MacroPrompDialog.Free;
end;
end;
{ TMacroPrompDialog }
constructor TMacroPrompDialog.Create(AnOwner: TComponent);
begin
inherited Create(AnOwner);
if LazarusResources.Find(ClassName)=nil then begin
Caption:='Enter data';
SetBounds((Screen.Width-300) div 2,(Screen.Height-150) div 2,300,150);
NoteLabel:=TLabel.Create(Self);
with NoteLabel do begin
Name:='NoteLabel';
Parent:=Self;
SetBounds(8,8,200,25);
Caption:='Enter run parameters';
Visible:=true;
end;
DataEdit:=TEdit.Create(Self);
with DataEdit do begin
Name:='DataEdit';
Parent:=Self;
SetBounds(8,NoteLabel.Top+NoteLabel.Height+5,Self.ClientWidth-20,25);
OnKeyDown:=@DataEditKeyDown;
Visible:=true;
end;
OkButton:=TButton.Create(Self);
with OkButton do begin
Name:='OkButton';
Parent:=Self;
SetBounds(Self.ClientWidth-200,Self.ClientHeight-40,80,25);
Caption:='Ok';
OnClick:=@OkButtonClick;
Visible:=true;
end;
CancelButton:=TButton.Create(Self);
with CancelButton do begin
Name:='CancelButton';
Parent:=Self;
SetBounds(Self.ClientWidth-100,Self.ClientHeight-40,80,25);
Caption:='Cancel';
OnClick:=@CancelButtonClick;
Visible:=true;
end;
end;
DataEdit.SetFocus;
end;
procedure TMacroPrompDialog.OkButtonClick(Sender: TObject);
begin
ModalResult:=mrOk;
end;
procedure TMacroPrompDialog.CancelButtonClick(Sender: TObject);
begin
ModalResult:=mrCancel;
end;
procedure TMacroPrompDialog.DataEditKeyDown(Sender: TObject; var Key:Word;
Shift:TShiftState);
begin
if (Key=VK_RETURN) then ModalResult:=mrOk;
if (Key=VK_ESCAPE) then ModalResult:=mrCancel;
end;
end.

246
ide/main.pp
View File

@ -39,12 +39,20 @@ uses
IDEComp, AbstractFormEditor, FormEditor, CustomFormEditor, ObjectInspector,
PropEdits, ControlSelection, UnitEditor, CompilerOptions, EditorOptions,
EnvironmentOpts, TransferMacros, KeyMapping, ProjectOpts, IDEProcs, Process,
UnitInfoDlg, Debugger, RunParamsOpts;
UnitInfoDlg, Debugger, RunParamsOpts, ExtToolDialog, MacroPromptDlg;
const
Version_String = '0.8 alpha';
type
{
The IDE is at anytime in a specific state:
itNone: The default mode. All editing allowed.
itBuilder: compiling the project. Loading/Saving/Debugging is not allowed.
itDebugger: debugging the project. Loading/Saving/Compiling is not allowed.
itCustom: this state is not used yet.
}
TIDEToolStatus = (itNone, itBuilder, itDebugger, itCustom);
TMainIDE = class(TForm)
@ -62,16 +70,8 @@ type
StepIntoSpeedButton : TSpeedButton;
StepOverSpeedButton : TSpeedButton;
OpenFilePopUpMenu : TPopupMenu;
Toolbutton1 : TToolButton;
Toolbutton2 : TToolButton;
Toolbutton3 : TToolButton;
Toolbutton4 : TToolButton;
GlobalMouseSpeedButton : TSpeedButton;
ComboBox1 : TComboBox;
Edit1: TEdit;
SpinEdit1 : TSpinEdit;
ListBox1 : TListBox;
mnuMain: TMainMenu;
mnuFile: TMenuItem;
@ -80,6 +80,7 @@ type
mnuView: TMenuItem;
mnuProject: TMenuItem;
mnuRun: TMenuItem;
mnuTools: TMenuItem;
mnuEnvironment:TMenuItem;
itmSeperator: TMenuItem;
@ -94,27 +95,6 @@ type
itmFileClose: TMenuItem;
itmFileQuit: TMenuItem;
itmProjectNew: TMenuItem;
itmProjectOpen: TMenuItem;
itmProjectRecentOpen: TMenuItem;
itmProjectSave: TMenuItem;
itmProjectSaveAs: TMenuItem;
itmProjectAddTo: TMenuItem;
itmProjectRemoveFrom: TMenuItem;
itmProjectViewSource: TMenuItem;
itmProjectOptions: TMenuItem;
itmProjectBuild: TMenuItem;
itmProjectBuildAll: TMenuItem;
itmProjectRun: TMenuItem;
itmProjectPause: TMenuItem;
itmProjectStepInto: TMenuItem;
itmProjectStepOver: TMenuItem;
itmProjectRunToCursor: TMenuItem;
itmProjectStop: TMenuItem;
itmProjectCompilerSettings: TMenuItem;
itmProjectRunParameters: TMenuItem;
itmEditUndo: TMenuItem;
itmEditRedo: TMenuItem;
itmEditCut: TMenuItem;
@ -136,14 +116,33 @@ type
itmViewFile : TMenuItem;
itmViewMessage : TMenuItem;
itmProjectNew: TMenuItem;
itmProjectOpen: TMenuItem;
itmProjectRecentOpen: TMenuItem;
itmProjectSave: TMenuItem;
itmProjectSaveAs: TMenuItem;
itmProjectAddTo: TMenuItem;
itmProjectRemoveFrom: TMenuItem;
itmProjectViewSource: TMenuItem;
itmProjectOptions: TMenuItem;
itmProjectBuild: TMenuItem;
itmProjectBuildAll: TMenuItem;
itmProjectRun: TMenuItem;
itmProjectPause: TMenuItem;
itmProjectStepInto: TMenuItem;
itmProjectStepOver: TMenuItem;
itmProjectRunToCursor: TMenuItem;
itmProjectStop: TMenuItem;
itmProjectCompilerSettings: TMenuItem;
itmProjectRunParameters: TMenuItem;
itmToolConfigure: TMenuItem;
itmEnvGeneralOptions: TMenuItem;
itmEnvEditorOptions: TMenuItem;
CheckBox1 : TCheckBox;
ComponentNotebook : TNotebook;
cmdTest: TButton;
cmdTest2: TButton;
Label2 : TLabel;
// event handlers
procedure FormShow(Sender : TObject);
@ -164,6 +163,9 @@ type
procedure mnuViewInspectorClicked(Sender : TObject);
Procedure mnuViewUnitsClicked(Sender : TObject);
Procedure mnuViewFormsClicked(Sender : TObject);
procedure mnuViewCodeExplorerClick(Sender : TObject);
procedure mnuViewMessagesClick(Sender : TObject);
procedure MessageViewDblClick(Sender : TObject);
procedure mnuToggleFormUnitClicked(Sender : TObject);
@ -187,9 +189,7 @@ type
procedure mnuRunParametersClicked(Sender : TObject);
procedure mnuProjectCompilerSettingsClicked(Sender : TObject);
procedure mnuViewCodeExplorerClick(Sender : TObject);
procedure mnuViewMessagesClick(Sender : TObject);
procedure MessageViewDblClick(Sender : TObject);
procedure mnuToolConfigureClicked(Sender : TObject);
procedure mnuEnvGeneralOptionsClicked(Sender : TObject);
procedure mnuEnvEditorOptionsClicked(Sender : TObject);
@ -286,6 +286,9 @@ type
function SomethingOfProjectIsModified: boolean;
function DoCreateProjectForProgram(ProgramBuf: TCodeBuffer): TModalResult;
function DoSaveProjectToTestDirectory: TModalResult;
// external tools
function DoRunExternalTool(Index: integer): TModalResult;
// useful methods
procedure GetCurrentUnit(var ActiveSourceEditor:TSourceEditor;
@ -306,10 +309,12 @@ type
procedure DoBringToFrontFormOrUnit;
procedure OnMacroSubstitution(TheMacro: TTransferMacro; var s:string;
var Handled, Abort: boolean);
function OnMacroPromptFunction(const s:string; var Abort: boolean):string;
procedure OnCmdLineCreate(var CmdLine: string; var Abort:boolean);
function DoJumpToCompilerMessage(Index:integer;
FocusEditor: boolean): boolean;
procedure DoShowMessagesView;
function GetProjectTargetFilename: string;
function GetTestProjectFilename: string;
function GetTestUnitFilename(AnUnitInfo: TUnitInfo): string;
procedure SaveSourceEditorChangesToCodeCache;
@ -436,6 +441,8 @@ begin
EditorOpts:=TEditorOptions.Create;
EditorOpts.Load;
EnvironmentOptions.ExternalTools.LoadShortCuts(EditorOpts.KeyMap);
// set the IDE mode to none (= editing mode)
ToolStatus:=itNone;
@ -576,19 +583,34 @@ begin
// macros
MacroList:=TTransferMacroList.Create;
MacroList.Add(TTransferMacro.Create('Col','',nil));
MacroList.Add(TTransferMacro.Create('Row','',nil));
MacroList.Add(TTransferMacro.Create('EdFile','',nil));
MacroList.Add(TTransferMacro.Create('CurToken','',nil));
MacroList.Add(TTransferMacro.Create('ProjFile','',nil));
MacroList.Add(TTransferMacro.Create('ProjPath','',nil));
MacroList.Add(TTransferMacro.Create('Save','',nil));
MacroList.Add(TTransferMacro.Create('SaveAll','',nil));
MacroList.Add(TTransferMacro.Create('Params','',nil));
MacroList.Add(TTransferMacro.Create('TargetFile','',nil));
MacroList.Add(TTransferMacro.Create('CompPath','',nil));
MacroList.Add(TTransferMacro.Create('FPCSrcDir','',nil));
MacroList.Add(TTransferMacro.Create('LazarusDir','',nil));
MacroList.Add(TTransferMacro.Create('Col','',
'Cursor column in current editor',nil));
MacroList.Add(TTransferMacro.Create('Row','',
'Cursor row in current editor',nil));
MacroList.Add(TTransferMacro.Create('CompPath','',
'Compiler filename',nil));
MacroList.Add(TTransferMacro.Create('CurToken','',
'Word at cursor in current editor',nil));
MacroList.Add(TTransferMacro.Create('EdFile','',
'Expanded filename of current editor file',nil));
MacroList.Add(TTransferMacro.Create('FPCSrcDir','',
'Freepascal source directory',nil));
MacroList.Add(TTransferMacro.Create('LazarusDir','',
'Lazarus directory',nil));
MacroList.Add(TTransferMacro.Create('Params','',
'Command line parameters of program',nil));
MacroList.Add(TTransferMacro.Create('Prompt','',
'Prompt for value',@OnMacroPromptFunction));
MacroList.Add(TTransferMacro.Create('ProjFile','',
'Project filename',nil));
MacroList.Add(TTransferMacro.Create('ProjPath','',
'Project directory',nil));
MacroList.Add(TTransferMacro.Create('Save','',
'save current editor file',nil));
MacroList.Add(TTransferMacro.Create('SaveAll','',
'save all modified files',nil));
MacroList.Add(TTransferMacro.Create('TargetFile','',
'Target filename of project',nil));
MacroList.OnSubstitution:=@OnMacroSubstitution;
// control selection (selected components on edited form)
@ -867,6 +889,11 @@ begin
mnuRun.Caption := '&Run';
mnuMain.Items.Add(mnuRun);
mnuTools := TMenuItem.Create(Self);
mnuTools.Name:='mnuTools';
mnuTools.Caption := '&Tools';
mnuMain.Items.Add(mnuTools);
mnuEnvironment := TMenuItem.Create(Self);
mnuEnvironment.Name:='mnuEnvironment';
mnuEnvironment.Caption := 'E&nvironment';
@ -1178,6 +1205,17 @@ begin
itmProjectRunParameters.OnClick := @mnuRunParametersClicked;
mnuRun.Add(itmProjectRunParameters);
//--------------
// Tools
//--------------
itmToolConfigure := TMenuItem.Create(Self);
itmToolConfigure.Name:='itmToolConfigure ';
itmToolConfigure.Caption := 'Settings ...';
itmToolConfigure.OnClick := @mnuToolConfigureClicked;
mnuTools.Add(itmToolConfigure);
//--------------
// Environment
//--------------
@ -1462,6 +1500,7 @@ begin
begin
DoBuildProject(Command=ecBuildAll);
end;
ecRun:
begin
if ToolStatus=itNone then
@ -1471,10 +1510,12 @@ begin
end;
DoRunProject;
end;
ecPause:
begin
DoPauseProject;
end;
ecStepInto:
begin
if ToolStatus=itNone then
@ -1484,6 +1525,7 @@ begin
end;
DoStepIntoProject;
end;
ecStepOver:
begin
if ToolStatus=itNone then
@ -1493,6 +1535,7 @@ begin
end;
DoStepOverProject;
end;
ecRunToCursor:
begin
if ToolStatus=itNone then
@ -1502,18 +1545,27 @@ begin
end;
DoRunToCursor;
end;
ecStopProgram:
begin
DoStopProject;
end;
ecFindProcedureDefinition,ecFindProcedureMethod:
begin
DoJumpToProcedureSection;
end;
ecCompleteCode:
begin
DoCompleteCodeAtCursor;
end;
ecExtToolFirst..ecExtToolLast:
begin
DoRunExternalTool(Command-ecExtToolFirst);
end;
else
Handled:=false;
end;
@ -1813,7 +1865,23 @@ begin
end;
end;
//------------------------------------------------------------------------------
procedure TMainIDE.mnuToolConfigureClicked(Sender : TObject);
begin
if ShowExtToolDialog(EnvironmentOptions.ExternalTools,MacroList)=mrOk then
begin
// save to enviroment options
SaveDesktopSettings(EnvironmentOptions);
EnvironmentOptions.Save(false);
// save shortcuts to editor options
EnvironmentOptions.ExternalTools.SaveShortCuts(EditorOpts.KeyMap);
EditorOpts.Save;
SourceNotebook.ReloadEditorOptions;
// ToDo: update menu
end;
end;
//------------------------------------------------------------------------------
@ -1849,8 +1917,12 @@ begin
with CodeToolBoss.GlobalValues do begin
Variables[ExternalMacroStart+'LazarusSrcDir']:=
TheEnvironmentOptions.LazarusDirectory;
// ToDo: rebuild define template if changed
Variables[ExternalMacroStart+'FPCSrcDir']:=
TheEnvironmentOptions.FPCSourceDirectory;
// ToDo: rebuild define template if changed
end;
end;
@ -1871,13 +1943,17 @@ var EnvironmentOptionsDialog: TEnvironmentOptionsDialog;
Begin
EnvironmentOptionsDialog:=TEnvironmentOptionsDialog.Create(Application);
try
// update EnvironmentOptions (save current window positions)
SaveDesktopSettings(EnvironmentOptions);
with EnvironmentOptionsDialog do begin
SaveDesktopSettings(EnvironmentOptions);
OnLoadEnvironmentSettings:=@Self.OnLoadEnvironmentSettings;
OnSaveEnvironmentSettings:=@Self.OnSaveEnvironmentSettings;
// load settings from EnvironmentOptions to EnvironmentOptionsDialog
ReadSettings(EnvironmentOptions);
if ShowModal=mrOk then begin
// load settings from EnvironmentOptionsDialog to EnvironmentOptions
WriteSettings(EnvironmentOptions);
// save to disk
EnvironmentOptions.Save(false);
end;
end;
@ -3325,7 +3401,6 @@ function TMainIDE.DoRunProject: TModalResult;
var
TheProcess : TProcess;
ProgramFilename, AText : String;
MainUnitInfo: TUnitInfo;
begin
Result:=mrCancel;
writeln('[TMainIDE.DoRunProject] A');
@ -3337,14 +3412,8 @@ writeln('[TMainIDE.DoRunProject] A');
or (Project.MainUnit<0) then
exit;
MainUnitInfo:=Project.Units[Project.MainUnit];
if Project.IsVirtual then
ProgramFilename:=GetTestProjectFilename
else begin
ProgramFilename:=
Project.CompilerOptions.CreateTargetFilename(MainUnitInfo.Filename);
end;
//MainUnitInfo:=Project.Units[Project.MainUnit];
ProgramFilename:=GetProjectTargetFilename;
if not FileExists(ProgramFilename) then begin
AText:='No program file "'+ProgramFilename+'" found!';
@ -3467,7 +3536,7 @@ end;
function TMainIDE.DoInitDebugger: TModalResult;
var ProgramFilename: string;
MainUnitInfo: TUnitInfo;
// MainUnitInfo: TUnitInfo;
begin
Result:=mrCancel;
if Project.MainUnit<0 then exit;
@ -3497,11 +3566,8 @@ begin
exit;
end;
end;
MainUnitInfo:=Project.Units[Project.MainUnit];
if MainUnitInfo.IsVirtual then
ProgramFilename:=GetTestProjectFilename
else
ProgramFilename:=ChangeFileExt(MainUnitInfo.Filename,Project.TargetFileExt);
//MainUnitInfo:=Project.Units[Project.MainUnit];
ProgramFilename:=GetProjectTargetFilename;
TheDebugger.Filename:=ProgramFilename;
TheDebugger.OnState:=@OnDebuggerChangeState;
TheDebugger.OnCurrent:=@OnDebuggerCurrentLine;
@ -3577,6 +3643,15 @@ writeln('TMainIDE.DoSaveAll');
// ToDo: save package, cvs settings, ...
end;
//-----------------------------------------------------------------------------
function TMainIDE.DoRunExternalTool(Index: integer): TModalResult;
begin
Result:=EnvironmentOptions.ExternalTools.Run(Index,MacroList);
end;
//-----------------------------------------------------------------------------
procedure TMainIDE.GetCurrentUnit(var ActiveSourceEditor:TSourceEditor;
var ActiveUnitInfo:TUnitInfo);
begin
@ -3902,7 +3977,8 @@ begin
end else if MacroName='curtoken' then begin
Handled:=true;
if SourceNoteBook.NoteBook<>nil then
s:=IntToStr(SourceNoteBook.GetActiveSE.EditorComponent.CaretY);
s:=SourceNoteBook.GetActiveSE.EditorComponent.GetWordAtRowCol(
SourceNoteBook.GetActiveSE.EditorComponent.CaretXY);
end else if MacroName='lazarusdir' then begin
Handled:=true;
s:=EnvironmentOptions.LazarusDirectory;
@ -3913,12 +3989,20 @@ begin
end else if MacroName='comppath' then begin
Handled:=true;
s:=EnvironmentOptions.CompilerFilename;
end else if MacroName='params' then begin
Handled:=true;
s:=Project.RunParameterOptions.CmdLineParams;
end else if MacroName='targetfile' then begin
Handled:=true;
s:=GetProjectTargetFilename;
end;
// ToDo:
//MacroList.Add(TIDEMacro.Create('CurToken','',nil));
//MacroList.Add(TIDEMacro.Create('Params','',nil));
//MacroList.Add(TIDEMacro.Create('TargetFile','',nil));
end;
function TMainIDE.OnMacroPromptFunction(const s:string;
var Abort: boolean):string;
begin
Result:=s;
Abort:=(ShowMacroPromptDialog(Result)<>mrOk);
end;
procedure TMainIDE.OnCmdLineCreate(var CmdLine: string; var Abort:boolean);
@ -4062,6 +4146,21 @@ begin
MessagesView.OnSelectionChanged := @MessagesViewSelectionChanged;
end;
function TMainIDE.GetProjectTargetFilename: string;
begin
Result:='';
if Project=nil then exit;
if Project.IsVirtual then
Result:=GetTestProjectFilename
else begin
if Project.MainUnit>=0 then begin
Result:=
Project.CompilerOptions.CreateTargetFilename(
Project.Units[Project.MainUnit].Filename)
end;
end;
end;
function TMainIDE.GetTestProjectFilename: string;
begin
Result:='';
@ -4429,7 +4528,7 @@ writeln('[TMainIDE.DoCompleteCodeAtCursor] ************');
end else begin
// error: probably a syntax error or just not in a procedure head/body
// or not in a class
// -> there are enough events to handle everything, so it is ignored here
// -> there are enough events to handle everything, so it can be ignored here
ApplyCodeToolChanges;
end;
FOpenEditorsOnCodeToolChange:=false;
@ -4452,6 +4551,9 @@ end.
{ =============================================================================
$Log$
Revision 1.139 2001/11/09 18:15:20 lazarus
MG: added external tools
Revision 1.138 2001/11/07 16:14:11 lazarus
MG: fixes for the new compiler

74
ide/transfermacros.pp
View File

@ -46,14 +46,16 @@ type
TOnSubstitution = procedure(TheMacro: TTransferMacro; var s:string;
var Handled, Abort: boolean) of object;
TMacroFunction = function(s:string):string of object;
TMacroFunction = function(const s:string; var Abort: boolean):string of object;
TTransferMacro = class
public
Name: string;
Value: string;
Description: string;
MacroFunction: TMacroFunction;
constructor Create(AName, AValue:string; AMacroFunction: TMacroFunction);
constructor Create(AName, AValue, ADescription:string;
AMacroFunction: TMacroFunction);
end;
TTransferMacroList = class
@ -63,15 +65,15 @@ type
function GetItems(Index: integer): TTransferMacro;
procedure SetItems(Index: integer; NewMacro: TTransferMacro);
protected
function MF_Ext(Filename:string):string; virtual;
function MF_Path(Filename:string):string; virtual;
function MF_Name(Filename:string):string; virtual;
function MF_NameOnly(Filename:string):string; virtual;
function MF_Ext(const Filename:string; var Abort: boolean):string; virtual;
function MF_Path(const Filename:string; var Abort: boolean):string; virtual;
function MF_Name(const Filename:string; var Abort: boolean):string; virtual;
function MF_NameOnly(const Filename:string; var Abort: boolean):string; virtual;
public
constructor Create;
destructor Destroy; override;
property Items[Index: integer]: TTransferMacro read GetItems write SetItems; default;
procedure SetValue(MacroName, NewValue: string);
procedure SetValue(const MacroName, NewValue: string);
function Count: integer;
procedure Clear;
procedure Delete(Index: integer);
@ -88,11 +90,12 @@ implementation
{ TTransferMacro }
constructor TTransferMacro.Create(AName, AValue:string;
constructor TTransferMacro.Create(AName, AValue, ADescription:string;
AMacroFunction: TMacroFunction);
begin
Name:=AName;
Value:=AValue;
Description:=ADescription;
MacroFunction:=AMacroFunction;
end;
@ -102,10 +105,12 @@ constructor TTransferMacroList.Create;
begin
inherited Create;
fItems:=TList.Create;
Add(TTransferMacro.Create('Ext','',@MF_Ext));
Add(TTransferMacro.Create('Path','',@MF_Path));
Add(TTransferMacro.Create('Name','',@MF_Name));
Add(TTransferMacro.Create('NameOnly','',@MF_NameOnly));
Add(TTransferMacro.Create('Ext','','Function: extract file extension',@MF_Ext));
Add(TTransferMacro.Create('Path','','Function: extract file path',@MF_Path));
Add(TTransferMacro.Create('Name','','Function: extract file name+extension',
@MF_Name));
Add(TTransferMacro.Create('NameOnly','','Function: extract file name only',
@MF_NameOnly));
end;
destructor TTransferMacroList.Destroy;
@ -126,7 +131,7 @@ begin
fItems[Index]:=NewMacro;
end;
procedure TTransferMacroList.SetValue(MacroName, NewValue: string);
procedure TTransferMacroList.SetValue(const MacroName, NewValue: string);
var AMacro:TTransferMacro;
begin
AMacro:=FindByName(MacroName);
@ -166,7 +171,7 @@ var MacroStart,MacroEnd: integer;
var BracketClose:char;
begin
if s[Position]='(' then BracketClose:=')'
else BracketClose:='{';
else BracketClose:='}';
inc(Position);
while (Position<=length(s)) and (s[Position]<>BracketClose) do begin
if s[Position]='\' then
@ -182,9 +187,16 @@ begin
Result:=true;
MacroStart:=1;
repeat
while (MacroStart<=length(s))
and ((s[MacroStart]<>'$') or ((MacroStart>1) and (s[MacroStart-1]='\'))) do
inc(MacroStart);
while (MacroStart<=length(s)) do begin
if s[MacroStart]='$' then begin
if (MacroStart>1) and (s[MacroStart-1]='\') then begin
System.Delete(s,MacroStart-1,1);
end else begin
break;
end;
end else
inc(MacroStart);
end;
if MacroStart>length(s) then exit;
MacroEnd:=MacroStart+1;
while (MacroEnd<=length(s))
@ -202,9 +214,11 @@ begin
// Macro function -> substitute macro parameter first
MacroParam:=copy(MacroStr,length(MacroName)+3
,length(MacroStr)-length(MacroName)-3);
SubstituteStr(MacroParam);
MacroStr:=copy(MacroStr,1,length(MacroName)+2)+MacroParam
+copy(MacroStr,length(MacroStr),1);
if not SubstituteStr(MacroParam) then begin
Result:=false;
exit;
end;
MacroStr:=MacroParam;
AMacro:=FindByName(MacroName);
if Assigned(fOnSubstitution) then
fOnSubstitution(AMacro,MacroStr,Handled,Abort);
@ -213,7 +227,13 @@ begin
exit;
end;
if (not Handled) and (AMacro<>nil) and (Assigned(AMacro.MacroFunction)) then
MacroStr:=AMacro.MacroFunction(MacroStr);
begin
MacroStr:=AMacro.MacroFunction(MacroStr,Abort);
if Abort then begin
Result:=false;
exit;
end;
end;
end else begin
// Macro variable
MacroStr:=copy(s,MacroStart+2,MacroEnd-MacroStart-3);
@ -246,22 +266,26 @@ begin
Result:=nil;
end;
function TTransferMacroList.MF_Ext(Filename:string):string;
function TTransferMacroList.MF_Ext(const Filename:string;
var Abort: boolean):string;
begin
Result:=ExtractFileExt(Filename);
end;
function TTransferMacroList.MF_Path(Filename:string):string;
function TTransferMacroList.MF_Path(const Filename:string;
var Abort: boolean):string;
begin
Result:=ExtractFilePath(Filename);
end;
function TTransferMacroList.MF_Name(Filename:string):string;
function TTransferMacroList.MF_Name(const Filename:string;
var Abort: boolean):string;
begin
Result:=ExtractFilename(Filename);
end;
function TTransferMacroList.MF_NameOnly(Filename:string):string;
function TTransferMacroList.MF_NameOnly(const Filename:string;
var Abort: boolean):string;
var Ext:string;
begin
Result:=ExtractFileName(Filename);