paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-31 06:21:38 +01:00
Code Issues Packages Projects Releases Wiki Activity
e3e34bcf3d
lazarus/ideintf/idecommands.pas

1101 lines
37 KiB
ObjectPascal
Raw Blame History

{
*****************************************************************************
* *
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
* for details about the copyright. *
* *
* This program 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. *
* *
*****************************************************************************
Abstract:
Interface unit for IDE commands.
IDE commands are functions like open file, save, build, ... .
Every command can have up to two shortcuts. For example:
ecCopy: two shortcuts: Ctrl+C and Ctrl+Insert
ecDeleteChar: one shortcut: Delete
ecInsertDateTime: no shortcut
Commands are sorted into categories. For example:
ecCopy is in the category 'Selection'.
This is only to help the user find commands.
Scopes:
A command can work globally or only in some IDE windows.
For example: When the user presses a key in the source editor, the IDE
first searches in all commands with the Scope IDECmdScopeSrcEdit.
Then it will search in all commands without scope.
}
unit IDECommands;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLProc, Forms, LCLType, Menus, TextTools;
const
{ editor commands constants. see syneditkeycmds.pp for more
These values can change from version to version, so DO NOT save them to file!
To add one static key do the following:
1. Add a constant with a unique value in the list below.
2. Add it to GetDefaultKeyForCommand to define the default keys+shiftstates
3. Add it to EditorCommandToDescriptionString to define the description
4. Add it to TKeyCommandRelationList.CreateDefaultMapping to define the
category.
}
ecNone = 0;
ecFirstLazarus = 1001;
// search
ecFind = ecFirstLazarus + 1;
ecFindAgain = ecFirstLazarus + 2;
ecFindNext = ecFindAgain;
ecFindPrevious = ecFirstLazarus + 3;
ecReplace = ecFirstLazarus + 4;
ecIncrementalFind = ecFirstLazarus + 5;
ecFindProcedureDefinition = ecFirstLazarus + 6;
ecFindProcedureMethod = ecFirstLazarus + 7;
ecGotoLineNumber = ecFirstLazarus + 8;
ecFindNextWordOccurrence = ecFirstLazarus + 9;
ecFindPrevWordOccurrence = ecFirstLazarus + 10;
ecFindInFiles = ecFirstLazarus + 11;
ecJumpBack = ecFirstLazarus + 12;
ecJumpForward = ecFirstLazarus + 13;
ecAddJumpPoint = ecFirstLazarus + 14;
ecViewJumpHistory = ecFirstLazarus + 15;
ecJumpToNextError = ecFirstLazarus + 16;
ecJumpToPrevError = ecFirstLazarus + 17;
ecProcedureList = ecFirstLazarus + 18;
// search code
ecFindDeclaration = ecFirstLazarus + 20;
ecFindBlockOtherEnd = ecFirstLazarus + 21;
ecFindBlockStart = ecFirstLazarus + 22;
ecOpenFileAtCursor = ecFirstLazarus + 23;
ecGotoIncludeDirective = ecFirstLazarus + 24;
// edit selection
ecSelectionUpperCase = ecFirstLazarus + 50;
ecSelectionLowerCase = ecFirstLazarus + 51;
ecSelectionTabs2Spaces = ecFirstLazarus + 52;
ecSelectionEnclose = ecFirstLazarus + 53;
ecSelectionComment = ecFirstLazarus + 54;
ecSelectionUncomment = ecFirstLazarus + 55;
ecSelectionSort = ecFirstLazarus + 56;
ecSelectionBreakLines = ecFirstLazarus + 57;
ecSelectToBrace = ecFirstLazarus + 58;
ecSelectCodeBlock = ecFirstLazarus + 59;
ecSelectWord = ecFirstLazarus + 60;
ecSelectLine = ecFirstLazarus + 61;
ecSelectParagraph = ecFirstLazarus + 62;
ecSelectionConditional = ecFirstLazarus + 63;
ecToggleComment = ecFirstLazarus + 64;
// insert text
ecInsertCharacter = ecFirstLazarus + 80;
ecInsertGPLNotice = ecFirstLazarus + 81;
ecInsertLGPLNotice = ecFirstLazarus + 82;
ecInsertUserName = ecFirstLazarus + 83;
ecInsertDateTime = ecFirstLazarus + 84;
ecInsertChangeLogEntry = ecFirstLazarus + 85;
ecInsertCVSAuthor = ecFirstLazarus + 86;
ecInsertCVSDate = ecFirstLazarus + 87;
ecInsertCVSHeader = ecFirstLazarus + 88;
ecInsertCVSID = ecFirstLazarus + 89;
ecInsertCVSLog = ecFirstLazarus + 90;
ecInsertCVSName = ecFirstLazarus + 91;
ecInsertCVSRevision = ecFirstLazarus + 92;
ecInsertCVSSource = ecFirstLazarus + 93;
ecInsertModifiedLGPLNotice= ecFirstLazarus + 94;
ecInsertTodo = ecFirstLazarus + 95;
ecInsertGUID = ecFirstLazarus + 96;
// source tools
ecWordCompletion = ecFirstLazarus + 100;
ecCompleteCode = ecFirstLazarus + 101;
ecIdentCompletion = ecFirstLazarus + 102;
ecSyntaxCheck = ecFirstLazarus + 103;
ecGuessUnclosedBlock = ecFirstLazarus + 104;
ecGuessMisplacedIFDEF = ecFirstLazarus + 105;
ecConvertDFM2LFM = ecFirstLazarus + 106;
ecCheckLFM = ecFirstLazarus + 107;
ecConvertDelphiUnit = ecFirstLazarus + 108;
ecConvertDelphiProject = ecFirstLazarus + 109;
ecConvertDelphiPackage = ecFirstLazarus + 110;
ecConvertEncoding = ecFirstLazarus + 111;
ecMakeResourceString = ecFirstLazarus + 112;
ecDiff = ecFirstLazarus + 113;
ecExtractProc = ecFirstLazarus + 114;
ecFindIdentifierRefs = ecFirstLazarus + 115;
ecRenameIdentifier = ecFirstLazarus + 116;
ecInvertAssignment = ecFirstLazarus + 117;
ecShowCodeContext = ecFirstLazarus + 118;
ecShowAbstractMethods = ecFirstLazarus + 119;
ecRemoveEmptyMethods = ecFirstLazarus + 120;
ecRemoveUnusedUnits = ecFirstLazarus + 121;
ecFindOverloads = ecFirstLazarus + 122;
// file menu
ecNew = ecFirstLazarus + 201;
ecNewUnit = ecFirstLazarus + 202;
ecNewForm = ecFirstLazarus + 203;
ecOpen = ecFirstLazarus + 205;
ecRevert = ecFirstLazarus + 206;
ecSave = ecFirstLazarus + 207;
ecSaveAs = ecFirstLazarus + 208;
ecSaveAll = ecFirstLazarus + 209;
ecClose = ecFirstLazarus + 210;
ecCloseAll = ecFirstLazarus + 211;
ecCleanDirectory = ecFirstLazarus + 212;
ecRestart = ecFirstLazarus + 213;
ecQuit = ecFirstLazarus + 214;
// IDE navigation
ecToggleFormUnit = ecFirstLazarus + 301;
ecToggleObjectInsp = ecFirstLazarus + 302;
ecToggleSourceEditor = ecFirstLazarus + 303;
ecToggleCodeExpl = ecFirstLazarus + 304;
ecToggleFPDocEditor = ecFirstLazarus + 305;
ecToggleMessages = ecFirstLazarus + 306;
ecToggleWatches = ecFirstLazarus + 307;
ecToggleBreakPoints = ecFirstLazarus + 308;
ecToggleDebuggerOut = ecFirstLazarus + 309;
ecViewUnits = ecFirstLazarus + 310;
ecViewForms = ecFirstLazarus + 311;
ecViewUnitDependencies = ecFirstLazarus + 312;
ecViewUnitInfo = ecFirstLazarus + 313;
ecToggleLocals = ecFirstLazarus + 314;
ecToggleCallStack = ecFirstLazarus + 315;
ecToggleSearchResults = ecFirstLazarus + 316;
ecViewAnchorEditor = ecFirstLazarus + 317;
ecToggleCodeBrowser = ecFirstLazarus + 318;
ecToggleCompPalette = ecFirstLazarus + 319;
ecToggleIDESpeedBtns = ecFirstLazarus + 320;
ecViewComponents = ecFirstLazarus + 321;
ecToggleRestrictionBrowser = ecFirstLazarus + 322;
ecViewTodoList = ecFirstLazarus + 323;
ecToggleRegisters = ecFirstLazarus + 324;
ecToggleAssembler = ecFirstLazarus + 325;
// sourcenotebook commands
ecNextEditor = ecFirstLazarus + 330;
ecPrevEditor = ecFirstLazarus + 331;
ecMoveEditorLeft = ecFirstLazarus + 332;
ecMoveEditorRight = ecFirstLazarus + 333;
ecToggleBreakPoint = ecFirstLazarus + 334;
ecRemoveBreakPoint = ecFirstLazarus + 335;
ecMoveEditorLeftmost = ecFirstLazarus + 336;
ecMoveEditorRightmost = ecFirstLazarus + 337;
ecGotoEditor1 = ecFirstLazarus + 350;
ecGotoEditor2 = ecGotoEditor1 + 1;
ecGotoEditor3 = ecGotoEditor2 + 1;
ecGotoEditor4 = ecGotoEditor3 + 1;
ecGotoEditor5 = ecGotoEditor4 + 1;
ecGotoEditor6 = ecGotoEditor5 + 1;
ecGotoEditor7 = ecGotoEditor6 + 1;
ecGotoEditor8 = ecGotoEditor7 + 1;
ecGotoEditor9 = ecGotoEditor8 + 1;
ecGotoEditor0 = ecGotoEditor9 + 1;
// marker
ecSetFreeBookmark = ecFirstLazarus + 381;
ecPrevBookmark = ecFirstLazarus + 382;
ecNextBookmark = ecFirstLazarus + 383;
// compile menu
ecBuild = ecFirstLazarus + 400;
ecBuildAll = ecFirstLazarus + 401;
ecQuickCompile = ecFirstLazarus + 402;
ecAbortBuild = ecFirstLazarus + 403;
ecRun = ecFirstLazarus + 404;
ecPause = ecFirstLazarus + 405;
ecStepInto = ecFirstLazarus + 406;
ecStepOver = ecFirstLazarus + 407;
ecRunToCursor = ecFirstLazarus + 408;
ecStopProgram = ecFirstLazarus + 409;
ecResetDebugger = ecFirstLazarus + 410;
ecBuildLazarus = ecFirstLazarus + 411;
ecBuildFile = ecFirstLazarus + 412;
ecRunFile = ecFirstLazarus + 413;
ecConfigBuildFile = ecFirstLazarus + 414;
ecInspect = ecFirstLazarus + 415;
ecEvaluate = ecFirstLazarus + 416;
ecAddWatch = ecFirstLazarus + 417;
ecShowExecutionPoint = ecFirstLazarus + 418;
ecStepOut = ecFirstLazarus + 419;
// project menu
ecNewProject = ecFirstLazarus + 500;
ecNewProjectFromFile = ecFirstLazarus + 501;
ecOpenProject = ecFirstLazarus + 502;
ecCloseProject = ecFirstLazarus + 503;
ecSaveProject = ecFirstLazarus + 504;
ecSaveProjectAs = ecFirstLazarus + 505;
ecPublishProject = ecFirstLazarus + 506;
ecProjectInspector = ecFirstLazarus + 507;
ecAddCurUnitToProj = ecFirstLazarus + 508;
ecRemoveFromProj = ecFirstLazarus + 509;
ecViewProjectSource = ecFirstLazarus + 510;
ecProjectOptions = ecFirstLazarus + 512;
// components menu
ecOpenPackage = ecFirstLazarus + 600;
ecOpenPackageFile = ecFirstLazarus + 601;
ecOpenPackageOfCurUnit = ecFirstLazarus + 602;
ecAddCurUnitToPkg = ecFirstLazarus + 603;
ecPackageGraph = ecFirstLazarus + 604;
ecEditInstallPkgs = ecFirstLazarus + 605;
ecConfigCustomComps = ecFirstLazarus + 606;
ecNewPackage = ecFirstLazarus + 607;
// custom tools menu
ecExtToolFirst = ecFirstLazarus + 700;
ecExtToolLast = ecFirstLazarus + 799;
// option commmands
ecRunParameters = ecFirstLazarus + 800;
ecReserved0 = ecFirstLazarus + 801; // reserved
ecExtToolSettings = ecFirstLazarus + 802;
ecConfigBuildLazarus = ecFirstLazarus + 803;
ecEnvironmentOptions = ecFirstLazarus + 804;
ecReserved1 = ecFirstLazarus + 805; // reserved
ecEditCodeTemplates = ecFirstLazarus + 806;
ecReserved2 = ecFirstLazarus + 807; // reserved
ecCodeToolsDefinesEd = ecFirstLazarus + 808;
ecRescanFPCSrcDir = ecFirstLazarus + 809;
// help menu
ecAboutLazarus = ecFirstLazarus + 900;
ecOnlineHelp = ecFirstLazarus + 901;
ecReserved3 = ecFirstLazarus + 902; // reserved
ecContextHelp = ecFirstLazarus + 903;
ecEditContextHelp = ecFirstLazarus + 904;
ecReportingBug = ecFirstLazarus + 905;
// designer
ecDesignerCopy = ecFirstLazarus + 1000;
ecDesignerCut = ecFirstLazarus + 1001;
ecDesignerPaste = ecFirstLazarus + 1002;
ecDesignerSelectParent = ecFirstLazarus + 1003;
ecDesignerMoveToFront = ecFirstLazarus + 1004;
ecDesignerMoveToBack = ecFirstLazarus + 1005;
ecDesignerForwardOne = ecFirstLazarus + 1006;
ecDesignerBackOne = ecFirstLazarus + 1007;
// custom commands
ecLazarusLast = ecFirstLazarus + 2000;
type
TIDECommand = class;
TIDECommandCategory = class;
TNotifyProcedure = procedure(Sender: TObject);
{ TIDECommandScope
A TIDECommandScope defines a set of IDE windows that will share the same
IDE commands. An IDE command can be valid in several scopes at the same
time. }
{ TIDECommandScope }
TIDECommandScope = class(TPersistent)
private
FName: string;
FIDEWindowClasses: TFPList;// list of TCustomFormClass
FCategories: TFPList;
function GetCategories(Index: integer): TIDECommandCategory;
function GetIDEWindowClasses(Index: integer): TCustomFormClass;
public
constructor Create(const TheName: string);
destructor Destroy; override;
procedure AddWindowClass(AWindowClass: TCustomFormClass);
procedure RemoveWindowClass(AWindowClass: TCustomFormClass);
function IDEWindowClassCount: integer;
function CategoryCount: integer;
function HasIDEWindowClass(AWindowClass: TCustomFormClass): boolean;
function Intersects(AScope: TIDECommandScope): boolean;
procedure WriteDebugReport;
public
property Name: string read FName;
property IDEWindowClasses[Index: integer]: TCustomFormClass read GetIDEWindowClasses;
property Categories[Index: integer]: TIDECommandCategory read GetCategories;
end;
{ TIDECommandScopes }
TIDECommandScopes = class(TPersistent)
private
FItems: TFPList;
function GetItems(Index: integer): TIDECommandScope;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Add(NewItem: TIDECommandScope);
function IndexOf(AnItem: TIDECommandScope): Integer;
function IndexByName(const AName: string): Integer;
function FindByName(const AName: string): TIDECommandScope;
function CreateUniqueName(const AName: string): string;
function Count: integer;
public
property Items[Index: integer]: TIDECommandScope read GetItems;
end;
{ TIDEShortCut }
TIDEShortCut = record
Key1: word;
Shift1: TShiftState;
Key2: word;
Shift2: TShiftState;
end;
PIDEShortCut = ^TIDEShortCut;
{ TIDECommandCategory
TIDECommandCategory is used to divide the commands in handy packets }
TIDECommandCategory = class(TList)
private
procedure SetDescription(const AValue: string);
protected
FDescription: string;
FName: string;
FParent: TIDECommandCategory;
FScope: TIDECommandScope;
procedure SetScope(const AValue: TIDECommandScope);
public
destructor Destroy; override;
function ScopeIntersects(AScope: TIDECommandScope): boolean;
procedure WriteScopeDebugReport;
public
property Name: string read FName;
property Description: string read FDescription write SetDescription;
property Parent: TIDECommandCategory read FParent;
procedure Delete(Index: Integer); virtual;
property Scope: TIDECommandScope read FScope write SetScope;
end;
{ TIDECommand }
{ class for storing the keys of a single command
(shortcut-command relationship) }
TIDECommand = class
private
FCategory: TIDECommandCategory;
FCommand: word;
FLocalizedName: string;
FName: String;
FOnChange: TNotifyEvent;
FOnExecute: TNotifyEvent;
FOnExecuteProc: TNotifyProcedure;
FShortcutA: TIDEShortCut;
FShortcutB: TIDEShortCut;
protected
function GetLocalizedName: string; virtual;
procedure SetLocalizedName(const AValue: string); virtual;
procedure SetCategory(const AValue: TIDECommandCategory); virtual;
procedure SetShortcutA(const AValue: TIDEShortCut); virtual;
procedure SetShortcutB(const AValue: TIDEShortCut); virtual;
procedure Change;
public
function AsShortCut: TShortCut; virtual;
constructor Create(TheCategory: TIDECommandCategory; const TheName,
TheLocalizedName: String;
TheCommand: word; const TheShortcutA, TheShortcutB: TIDEShortCut;
const ExecuteMethod: TNotifyEvent;
const ExecuteProc: TNotifyProcedure);
constructor Create(ACommand: TIDECommand; ACategory: TIDECommandCategory);
destructor Destroy; override;
procedure Assign(ACommand: TIDECommand);
function IsEqual(ACommand: TIDECommand): boolean;
public
DefaultShortcutA: TIDEShortCut;
DefaultShortcutB: TIDEShortCut;
procedure ClearShortcutA;
procedure ClearShortcutB;
function GetCategoryAndName: string;
function Execute(Sender: TObject): boolean;
public
property Name: String read FName;
property Command: word read FCommand;// see the ecXXX constants above
property LocalizedName: string read GetLocalizedName write SetLocalizedName;
property Category: TIDECommandCategory read FCategory write SetCategory;
property ShortcutA: TIDEShortCut read FShortcutA write SetShortcutA;
property ShortcutB: TIDEShortCut read FShortcutB write SetShortcutB;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnExecute: TNotifyEvent read FOnExecute write FOnExecute;
property OnExecuteProc: TNotifyProcedure read FOnExecuteProc write FOnExecuteProc;
end;
{ TIDECommands }
TIDECommands = class
protected
function GetCategory(Index: integer): TIDECommandCategory; virtual; abstract;
public
function FindIDECommand(ACommand: word): TIDECommand; virtual; abstract;
function CreateCategory(Parent: TIDECommandCategory;
const Name, Description: string;
Scope: TIDECommandScope = nil): TIDECommandCategory; virtual; abstract;
function CreateCommand(Category: TIDECommandCategory;
const Name, Description: string;
const TheShortcutA, TheShortcutB: TIDEShortCut;
const OnExecuteMethod: TNotifyEvent = nil;
const OnExecuteProc: TNotifyProcedure = nil
): TIDECommand; virtual; abstract;
function FindCategoryByName(const CategoryName: string): TIDECommandCategory; virtual; abstract;
function FindCommandByName(const CommandName: string): TIDECommand; virtual; abstract;
function CategoryCount: integer; virtual; abstract;
public
property Categories[Index: integer]: TIDECommandCategory read GetCategory;
end;
const
CleanIDEShortCut: TIDEShortCut =
(Key1: VK_UNKNOWN; Shift1: []; Key2: VK_UNKNOWN; Shift2: []);
function IDEShortCut(Key1: word; Shift1: TShiftState;
Key2: word = VK_UNKNOWN; Shift2: TShiftState = []): TIDEShortCut;
type
TExecuteIDEShortCut =
procedure(Sender: TObject; var Key: word; Shift: TShiftState;
IDEWindowClass: TCustomFormClass) of object;
TExecuteIDECommand = function(Sender: TObject; Command: word): boolean of object;
var
OnExecuteIDEShortCut: TExecuteIDEShortCut;
OnExecuteIDECommand: TExecuteIDECommand;
procedure ExecuteIDEShortCut(Sender: TObject; var Key: word; Shift: TShiftState;
IDEWindowClass: TCustomFormClass);
procedure ExecuteIDEShortCut(Sender: TObject; var Key: word; Shift: TShiftState);
function ExecuteIDECommand(Sender: TObject; Command: word): boolean;
function IDEShortCutToMenuShortCut(const IDEShortCut: TIDEShortCut): TShortCut;
var
// will be set by the IDE
IDECommandList: TIDECommands;
IDECommandScopes: TIDECommandScopes = nil;
var
IDECmdScopeSrcEdit: TIDECommandScope;
IDECmdScopeSrcEditOnly: TIDECommandScope;
IDECmdScopeSrcEditOnlyTmplEdit: TIDECommandScope;
IDECmdScopeSrcEditOnlyTmplEditOff: TIDECommandScope;
IDECmdScopeSrcEditOnlySyncroEditSel: TIDECommandScope;
IDECmdScopeSrcEditOnlySyncroEdit: TIDECommandScope;
IDECmdScopeSrcEditOnlySyncroEditOff: TIDECommandScope;
IDECmdScopeDesignerOnly: TIDECommandScope;
IDECmdScopeObjectInspectorOnly: TIDECommandScope;
const
CommandCategoryToolMenuName = 'ToolMenu';
CommandCategoryCustomName = 'Custom';
// register a new IDE command category (i.e. set of commands)
function RegisterIDECommandCategory(Parent: TIDECommandCategory;
const Name, Description: string): TIDECommandCategory;
// register a new IDE command (i.e. a shortcut, IDE function)
function RegisterIDECommand(Category: TIDECommandCategory;
const Name, Description: string;
const OnExecuteMethod: TNotifyEvent = nil;
const OnExecuteProc: TNotifyProcedure = nil): TIDECommand;
function RegisterIDECommand(Category: TIDECommandCategory;
const Name, Description: string; Key1: word; Shift1: TShiftState;
const OnExecuteMethod: TNotifyEvent = nil;
const OnExecuteProc: TNotifyProcedure = nil): TIDECommand;
function RegisterIDECommand(Category: TIDECommandCategory;
const Name, Description: string; const ShortCut1: TIDEShortCut;
const OnExecuteMethod: TNotifyEvent = nil;
const OnExecuteProc: TNotifyProcedure = nil): TIDECommand;
function RegisterIDECommand(Category: TIDECommandCategory;
const Name, Description: string;
const ShortCut1, ShortCut2: TIDEShortCut;
const OnExecuteMethod: TNotifyEvent = nil;
const OnExecuteProc: TNotifyProcedure = nil): TIDECommand;
// register a new IDE command scope (i.e. a set of windows)
function RegisterIDECommandScope(const Name: string): TIDECommandScope;
procedure CreateStandardIDECommandScopes;
function CompareIDEShortCuts(Data1, Data2: Pointer): integer;
function CompareIDEShortCutKey1s(Data1, Data2: Pointer): integer;
function IdentToIDECommand(const Ident: string; var Cmd: longint): boolean;
function IDECommandToIdent(Cmd: longint; var Ident: string): boolean;
implementation
function IDEShortCut(Key1: word; Shift1: TShiftState;
Key2: word; Shift2: TShiftState): TIDEShortCut;
begin
Result.Key1:=Key1;
Result.Shift1:=Shift1;
Result.Key2:=Key2;
Result.Shift2:=Shift2;
end;
procedure ExecuteIDEShortCut(Sender: TObject; var Key: word; Shift: TShiftState;
IDEWindowClass: TCustomFormClass);
begin
if (OnExecuteIDECommand<>nil) and (Key<>VK_UNKNOWN) then
OnExecuteIDEShortCut(Sender,Key,Shift,IDEWindowClass);
end;
procedure ExecuteIDEShortCut(Sender: TObject; var Key: word;
Shift: TShiftState);
begin
OnExecuteIDEShortCut(Sender,Key,Shift,nil);
end;
function ExecuteIDECommand(Sender: TObject; Command: word): boolean;
begin
if (OnExecuteIDECommand<>nil) and (Command<>0) then
Result:=OnExecuteIDECommand(Sender,Command)
else
Result:=false;
end;
function IDEShortCutToMenuShortCut(const IDEShortCut: TIDEShortCut): TShortCut;
begin
if IDEShortCut.Key2=VK_UNKNOWN then
Result:=ShortCut(IDEShortCut.Key1,IDEShortCut.Shift1)
else
Result:=ShortCut(VK_UNKNOWN,[]);
end;
procedure CreateStandardIDECommandScopes;
begin
IDECommandScopes:=TIDECommandScopes.Create;
IDECmdScopeSrcEdit:=RegisterIDECommandScope('SourceEditor');
IDECmdScopeSrcEditOnly:=RegisterIDECommandScope('SourceEditorOnly');
IDECmdScopeSrcEditOnlyTmplEdit:=RegisterIDECommandScope('SourceEditorOnlyTemplateEdit');
IDECmdScopeSrcEditOnlyTmplEditOff:=RegisterIDECommandScope('SourceEditorOnlyTemplateEditOff');
IDECmdScopeSrcEditOnlySyncroEditSel:=RegisterIDECommandScope('SourceEditorOnlySyncroEditSel');
IDECmdScopeSrcEditOnlySyncroEdit:=RegisterIDECommandScope('SourceEditorOnlySyncroEdit');
IDECmdScopeSrcEditOnlySyncroEditOff:=RegisterIDECommandScope('SourceEditorOnlySyncroEdit');
IDECmdScopeDesignerOnly:=RegisterIDECommandScope('DesignerOnly');
IDECmdScopeObjectInspectorOnly:=RegisterIDECommandScope('ObjectInspectorOnly');
end;
type
// in fpc 2.3.1 TShiftState is declared with {$packset 1}
{$IF sizeof(TShiftState)=2}
TShiftStateInt = word;
{$ELSE}
TShiftStateInt = integer;
{$ENDIF}
function CompareIDEShortCuts(Data1, Data2: Pointer): integer;
var
ShortCut1: PIDEShortCut absolute Data1;
ShortCut2: PIDEShortCut absolute Data2;
begin
if ShortCut1^.Key1>ShortCut2^.Key1 then
Result:=1
else if ShortCut1^.Key1<ShortCut2^.Key1 then
Result:=-1
else if TShiftStateInt(ShortCut1^.Shift1)>TShiftStateInt(ShortCut2^.Shift1) then
Result:=1
else if TShiftStateInt(ShortCut1^.Shift1)<TShiftStateInt(ShortCut2^.Shift1) then
Result:=-1
else if ShortCut1^.Key2>ShortCut2^.Key2 then
Result:=1
else if ShortCut1^.Key2<ShortCut2^.Key2 then
Result:=-1
else if TShiftStateInt(ShortCut1^.Shift2)>TShiftStateInt(ShortCut2^.Shift2) then
Result:=1
else if TShiftStateInt(ShortCut1^.Shift2)<TShiftStateInt(ShortCut2^.Shift2) then
Result:=-1
else
Result:=0;
end;
function CompareIDEShortCutKey1s(Data1, Data2: Pointer): integer;
var
ShortCut1: PIDEShortCut;
ShortCut2: PIDEShortCut;
begin
ShortCut1:=PIDEShortCut(Data1);
ShortCut2:=PIDEShortCut(Data2);
if ShortCut1^.Key1>ShortCut2^.Key1 then
Result:=1
else if ShortCut1^.Key1<ShortCut2^.Key1 then
Result:=-1
else if TShiftStateInt(ShortCut1^.Shift1)>TShiftStateInt(ShortCut2^.Shift1) then
Result:=1
else if TShiftStateInt(ShortCut1^.Shift1)<TShiftStateInt(ShortCut2^.Shift1) then
Result:=-1
else
Result:=0;
end;
function RegisterIDECommandCategory(Parent: TIDECommandCategory;
const Name, Description: string): TIDECommandCategory;
begin
Result:=IDECommandList.CreateCategory(Parent,Name,Description);
end;
function RegisterIDECommand(Category: TIDECommandCategory;
const Name, Description: string;
const OnExecuteMethod: TNotifyEvent = nil;
const OnExecuteProc: TNotifyProcedure = nil): TIDECommand;
begin
Result:=RegisterIDECommand(Category,Name,Description,IDEShortCut(VK_UNKNOWN,[]),
OnExecuteMethod,OnExecuteProc);
end;
function RegisterIDECommand(Category: TIDECommandCategory;
const Name, Description: string;
Key1: word; Shift1: TShiftState;
const OnExecuteMethod: TNotifyEvent;
const OnExecuteProc: TNotifyProcedure): TIDECommand;
begin
Result:=RegisterIDECommand(Category,Name,Description,IDEShortCut(Key1,Shift1),
OnExecuteMethod,OnExecuteProc);
end;
function RegisterIDECommand(Category: TIDECommandCategory;
const Name, Description: string; const ShortCut1: TIDEShortCut;
const OnExecuteMethod: TNotifyEvent;
const OnExecuteProc: TNotifyProcedure): TIDECommand;
begin
Result:=RegisterIDECommand(Category,Name,Description,
ShortCut1,IDEShortCut(VK_UNKNOWN,[]),
OnExecuteMethod,OnExecuteProc);
end;
function RegisterIDECommand(Category: TIDECommandCategory;
const Name, Description: string;
const ShortCut1, ShortCut2: TIDEShortCut;
const OnExecuteMethod: TNotifyEvent;
const OnExecuteProc: TNotifyProcedure): TIDECommand;
begin
Result:=IDECommandList.CreateCommand(Category,Name,Description,
ShortCut1,ShortCut2,OnExecuteMethod,
OnExecuteProc);
end;
function RegisterIDECommandScope(const Name: string): TIDECommandScope;
begin
Result:=TIDECommandScope.Create(Name);
IDECommandScopes.Add(Result);
end;
{ TIDECommand }
procedure TIDECommand.SetShortcutA(const AValue: TIDEShortCut);
begin
if CompareIDEShortCuts(@FShortcutA,@AValue)=0 then exit;
FShortcutA:=AValue;
//DebugLn('TIDECommand.SetShortcutA ',dbgs(Assigned(OnChange)),' ',Name);
Change;
end;
procedure TIDECommand.SetShortcutB(const AValue: TIDEShortCut);
begin
if CompareIDEShortCuts(@FShortcutB,@AValue)=0 then exit;
FShortcutB:=AValue;
//DebugLn('TIDECommand.SetShortcutB ',dbgs(Assigned(OnChange)),' ',Name);
Change;
end;
procedure TIDECommand.Change;
begin
if Assigned(OnChange) then OnChange(Self);
end;
function TIDECommand.GetLocalizedName: string;
begin
if FLocalizedName<>'' then
Result:=FLocalizedName
else
Result:=Name;
end;
procedure TIDECommand.SetLocalizedName(const AValue: string);
begin
if FLocalizedName=AValue then exit;
FLocalizedName:=AValue;
//DebugLn('TIDECommand.SetLocalizedName ',dbgs(Assigned(OnChange)),' ',Name);
Change;
end;
procedure TIDECommand.SetCategory(const AValue: TIDECommandCategory);
begin
if FCategory=AValue then exit;
// unbind
if Category<>nil then
Category.Remove(Self);
// bind
fCategory:=AValue;
if Category<>nil then
Category.Add(Self);
//DebugLn('TIDECommand.SetCategory ',dbgs(Assigned(OnChange)),' ',Name);
Change;
end;
function TIDECommand.AsShortCut: TShortCut;
var
CurKey: TIDEShortCut;
begin
if (ShortcutA.Key1<>VK_UNKNOWN) and (ShortcutA.Key2=VK_UNKNOWN) then
CurKey:=ShortcutA
else if (ShortcutB.Key1<>VK_UNKNOWN) and (ShortcutB.Key2=VK_UNKNOWN) then
CurKey:=ShortcutB
else
CurKey:=CleanIDEShortCut;
Result:=CurKey.Key1;
if ssCtrl in CurKey.Shift1 then
Result:=Result+scCtrl;
if ssShift in CurKey.Shift1 then
Result:=Result+scShift;
if ssAlt in CurKey.Shift1 then
Result:=Result+scAlt;
end;
constructor TIDECommand.Create(TheCategory: TIDECommandCategory;
const TheName, TheLocalizedName: String; TheCommand: word;
const TheShortcutA, TheShortcutB: TIDEShortCut;
const ExecuteMethod: TNotifyEvent;
const ExecuteProc: TNotifyProcedure);
begin
fCommand:=TheCommand;
fName:=TheName;
FLocalizedName:=TheLocalizedName;
fShortcutA:=TheShortcutA;
fShortcutB:=TheShortcutB;
DefaultShortcutA:=ShortcutA;
DefaultShortcutB:=ShortcutB;
Category:=TheCategory;
FOnExecute:=ExecuteMethod;
FOnExecuteProc:=ExecuteProc;
//DebugLn('TIDECommand.Create Name=',Name,' ',ShortCutToText(AsShortCut),' ',dbgs(Pointer(Self)));
end;
constructor TIDECommand.Create(ACommand: TIDECommand;
ACategory: TIDECommandCategory);
begin
fCommand:=ACommand.Command;
fName:=ACommand.Name;
FLocalizedName:=ACommand.LocalizedName;
fShortcutA:=ACommand.ShortcutA;
fShortcutB:=ACommand.ShortcutB;
DefaultShortcutA:=ACommand.ShortcutA;
DefaultShortcutB:=ACommand.ShortcutB;
Category:=ACategory;
end;
destructor TIDECommand.Destroy;
begin
inherited Destroy;
end;
procedure TIDECommand.Assign(ACommand: TIDECommand);
begin
if IsEqual(ACommand) then exit;
//DebugLn('TIDECommand.Assign ',dbgs(Assigned(OnChange)),' ',Name,' ');
FShortcutA:=ACommand.FShortcutA;
FShortcutB:=ACommand.FShortcutB;
Change;
end;
function TIDECommand.IsEqual(ACommand: TIDECommand): boolean;
begin
Result:=(CompareIDEShortCuts(@FShortcutA,@ACommand.FShortcutA)=0)
and (CompareIDEShortCuts(@FShortcutB,@ACommand.FShortcutB)=0);
end;
procedure TIDECommand.ClearShortcutA;
begin
ShortcutA:=CleanIDEShortCut;
end;
procedure TIDECommand.ClearShortcutB;
begin
ShortcutB:=CleanIDEShortCut;
end;
function TIDECommand.GetCategoryAndName: string;
begin
Result:='"'+GetLocalizedName+'"';
if Category<>nil then
Result:=Result+' in "'+Category.Description+'"';
end;
function TIDECommand.Execute(Sender: TObject): boolean;
begin
Result:=false;
if Assigned(OnExecute) then begin
Result:=true;
OnExecute(Sender);
end;
if Assigned(OnExecuteProc) then begin
Result:=true;
OnExecuteProc(Sender);
end;
end;
{ TIDECommandScopes }
function TIDECommandScopes.GetItems(Index: integer): TIDECommandScope;
begin
Result:=TIDECommandScope(FItems[Index]);
end;
constructor TIDECommandScopes.Create;
begin
FItems:=TFPList.Create;
end;
destructor TIDECommandScopes.Destroy;
begin
Clear;
FItems.Free;
inherited Destroy;
end;
procedure TIDECommandScopes.Clear;
var
i: Integer;
begin
for i:=0 to FItems.Count-1 do Items[i].Free;
FItems.Clear;
end;
procedure TIDECommandScopes.Add(NewItem: TIDECommandScope);
begin
NewItem.fName:=CreateUniqueName(NewItem.Name);
FItems.Add(NewItem);
end;
function TIDECommandScopes.IndexOf(AnItem: TIDECommandScope): Integer;
begin
Result:=FItems.IndexOf(AnItem);
end;
function TIDECommandScopes.IndexByName(const AName: string): Integer;
begin
Result:=Count-1;
while (Result>=0) and (CompareText(AName,Items[Result].Name)<>0) do
dec(Result);
end;
function TIDECommandScopes.FindByName(const AName: string): TIDECommandScope;
var
i: LongInt;
begin
i:=IndexByName(AName);
if i>=0 then
Result:=Items[i]
else
Result:=nil;
end;
function TIDECommandScopes.CreateUniqueName(const AName: string): string;
begin
Result:=AName;
if IndexByName(Result)<0 then exit;
Result:=CreateFirstIdentifier(Result);
while IndexByName(Result)>=0 do
Result:=CreateNextIdentifier(Result);
end;
function TIDECommandScopes.Count: integer;
begin
Result:=FItems.Count;
end;
{ TIDECommandCategory }
procedure TIDECommandCategory.SetDescription(const AValue: string);
begin
if FDescription=AValue then exit;
FDescription:=AValue;
end;
procedure TIDECommandCategory.SetScope(const AValue: TIDECommandScope);
begin
if FScope=AValue then exit;
if FScope<>nil then
FScope.FCategories.Remove(Self);
FScope:=AValue;
if FScope<>nil then
FScope.FCategories.Add(Self);
end;
destructor TIDECommandCategory.Destroy;
begin
Scope:=nil;
inherited Destroy;
end;
function TIDECommandCategory.ScopeIntersects(AScope: TIDECommandScope
): boolean;
begin
if (Scope=nil) or (AScope=nil) then
Result:=true
else
Result:=Scope.Intersects(AScope);
end;
procedure TIDECommandCategory.WriteScopeDebugReport;
begin
debugln('TIDECommandCategory.WriteScopeDebugReport ',Name,'=',Description);
if Scope<>nil then
Scope.WriteDebugReport
else
debugln(' Scope=nil');
end;
procedure TIDECommandCategory.Delete(Index: Integer);
begin
inherited Delete(Index);
end;
{ TIDECommandScope }
function TIDECommandScope.GetCategories(Index: integer): TIDECommandCategory;
begin
Result:=TIDECommandCategory(FCategories[Index]);
end;
function TIDECommandScope.GetIDEWindowClasses(Index: integer): TCustomFormClass;
begin
Result:=TCustomFormClass(FIDEWindowClasses[Index]);
end;
constructor TIDECommandScope.Create(const TheName: string);
begin
FName:=TheName;
FIDEWindowClasses:=TFPList.Create;
FCategories:=TFPList.Create;
end;
destructor TIDECommandScope.Destroy;
var
i: Integer;
begin
for i:=FCategories.Count-1 downto 0 do
Categories[i].Scope:=nil;
FreeAndNil(FIDEWindowClasses);
FreeAndNil(FCategories);
inherited Destroy;
end;
procedure TIDECommandScope.AddWindowClass(AWindowClass: TCustomFormClass);
begin
if FIDEWindowClasses.IndexOf(AWindowClass)>=0 then
RaiseGDBException('TIDECommandScope.AddWindowClass');
FIDEWindowClasses.Add(AWindowClass);
end;
procedure TIDECommandScope.RemoveWindowClass(AWindowClass: TCustomFormClass);
begin
FIDEWindowClasses.Remove(AWindowClass);
end;
function TIDECommandScope.IDEWindowClassCount: integer;
begin
Result:=FIDEWindowClasses.Count;
end;
function TIDECommandScope.CategoryCount: integer;
begin
Result:=FCategories.Count;
end;
function TIDECommandScope.HasIDEWindowClass(AWindowClass: TCustomFormClass
): boolean;
var
i: Integer;
begin
if AWindowClass<>nil then begin
for i:=0 to FIDEWindowClasses.Count-1 do begin
if (FIDEWindowClasses[i]=nil)
or AWindowClass.InheritsFrom(TCustomFormClass(FIDEWindowClasses[i])) then
exit(true);
end;
end else begin
if FIDEWindowClasses.IndexOf(nil)>=0 then
exit(true);
end;
Result:=false;
end;
function TIDECommandScope.Intersects(AScope: TIDECommandScope): boolean;
var
i: Integer;
CurClass: TCustomFormClass;
begin
if AScope=nil then
Result:=true
else begin
for i:=0 to FIDEWindowClasses.Count-1 do begin
CurClass:=TCustomFormClass(FIDEWindowClasses[i]);
if (CurClass=nil)
or (AScope.FIDEWindowClasses.IndexOf(FIDEWindowClasses[i])>=0) then
exit(true);
end;
Result:=false;
end;
end;
procedure TIDECommandScope.WriteDebugReport;
var
i: Integer;
begin
debugln('TIDECommandScope.WriteDebugReport ',Name);
for i:=0 to FIDEWindowClasses.Count-1 do begin
if FIDEWindowClasses[i]=nil then
debugln(' ',dbgs(i),'/',dbgs(FIDEWindowClasses.Count),' nil')
else
debugln(' ',dbgs(i),'/',dbgs(FIDEWindowClasses.Count),' ',TClass(FIDEWindowClasses[i]).ClassName);
end;
end;
function IdentToIDECommand(const Ident: string; var Cmd: longint): boolean;
var
IDECommand: TIDECommand;
begin
if IDECommandList=nil then exit(false);
IDECommand := IDECommandList.FindCommandByName(Ident);
if IDECommand=nil then exit(false);
Result:=true;
Cmd := IDECommand.Command;
end;
function IDECommandToIdent(Cmd: longint; var Ident: string): boolean;
var
IDECommand: TIDECommand;
begin
if IDECommandList=nil then exit(false);
IDECommand := IDECommandList.FindIDECommand(Cmd);
if IDECommand=nil then exit(false);
Result:=true;
Ident:=IDECommand.Name;
end;
end.
Reference in New Issue View Git Blame Copy Permalink