{ ***************************************************************************** * * * See the file COPYING.modifiedLGPL, 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: Under construction by Mattias 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. IDE experts: They are handled in the IDE interface units. } ecNone = 0; ecFirstLazarus = 1001; // search ecFind = ecFirstLazarus + 1; ecFindAgain = ecFirstLazarus + 2; ecFindNext = ecFindAgain; ecReplace = ecFirstLazarus + 3; ecIncrementalFind = ecFirstLazarus + 4; ecFindProcedureDefinition = ecFirstLazarus + 5; ecFindProcedureMethod = ecFirstLazarus + 6; ecGotoLineNumber = ecFirstLazarus + 7; ecFindPrevious = ecFirstLazarus + 8; ecFindInFiles = ecFirstLazarus + 9; ecJumpBack = ecFirstLazarus + 10; ecJumpForward = ecFirstLazarus + 11; ecAddJumpPoint = ecFirstLazarus + 12; ecViewJumpHistory = ecFirstLazarus + 13; ecJumpToNextError = ecFirstLazarus + 14; ecJumpToPrevError = ecFirstLazarus + 15; // 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; // 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; // 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; ecMakeResourceString = ecFirstLazarus + 111; ecDiff = ecFirstLazarus + 112; ecExtractProc = ecFirstLazarus + 113; ecFindIdentifierRefs = ecFirstLazarus + 114; ecRenameIdentifier = ecFirstLazarus + 115; ecInvertAssignment = ecFirstLazarus + 116; ecShowCodeContext = ecFirstLazarus + 117; // 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 ecJumpToEditor = ecFirstLazarus + 300; ecToggleFormUnit = ecFirstLazarus + 301; ecToggleObjectInsp = ecFirstLazarus + 302; ecToggleSourceEditor = ecFirstLazarus + 303; ecToggleCodeExpl = ecFirstLazarus + 304; ecToggleMessages = ecFirstLazarus + 305; ecToggleWatches = ecFirstLazarus + 306; ecToggleBreakPoints = ecFirstLazarus + 307; ecToggleDebuggerOut = ecFirstLazarus + 308; ecViewUnits = ecFirstLazarus + 309; ecViewForms = ecFirstLazarus + 310; ecViewUnitDependencies = ecFirstLazarus + 311; ecViewUnitInfo = ecFirstLazarus + 312; ecToggleLocals = ecFirstLazarus + 313; ecToggleCallStack = ecFirstLazarus + 314; ecToggleSearchResults = ecFirstLazarus + 315; ecViewAnchorEditor = ecFirstLazarus + 316; ecToggleCompPalette = ecFirstLazarus + 317; ecToggleIDESpeedBtns = ecFirstLazarus + 318; // sourcenotebook commands ecNextEditor = ecFirstLazarus + 330; ecPrevEditor = ecFirstLazarus + 331; ecMoveEditorLeft = ecFirstLazarus + 332; ecMoveEditorRight = ecFirstLazarus + 333; ecAddBreakPoint = ecFirstLazarus + 334; ecRemoveBreakPoint = ecFirstLazarus + 335; 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; ecAbortBuild = ecFirstLazarus + 402; ecRun = ecFirstLazarus + 403; ecPause = ecFirstLazarus + 404; ecStepInto = ecFirstLazarus + 405; ecStepOver = ecFirstLazarus + 406; ecRunToCursor = ecFirstLazarus + 407; ecStopProgram = ecFirstLazarus + 408; ecResetDebugger = ecFirstLazarus + 409; ecBuildLazarus = ecFirstLazarus + 410; ecBuildFile = ecFirstLazarus + 411; ecRunFile = ecFirstLazarus + 412; ecConfigBuildFile = ecFirstLazarus + 413; ecInspect = ecFirstLazarus + 414; ecEvaluate = ecFirstLazarus + 415; ecAddWatch = ecFirstLazarus + 416; // project menu ecNewProject = ecFirstLazarus + 500; ecNewProjectFromFile = ecFirstLazarus + 501; ecOpenProject = ecFirstLazarus + 502; ecSaveProject = ecFirstLazarus + 503; ecSaveProjectAs = ecFirstLazarus + 504; ecPublishProject = ecFirstLazarus + 505; ecProjectInspector = ecFirstLazarus + 506; ecAddCurUnitToProj = ecFirstLazarus + 507; ecRemoveFromProj = ecFirstLazarus + 508; ecViewProjectSource = ecFirstLazarus + 509; ecViewProjectTodos = ecFirstLazarus + 510; ecProjectOptions = ecFirstLazarus + 511; // components menu ecOpenPackage = ecFirstLazarus + 600; ecOpenPackageFile = ecFirstLazarus + 601; ecOpenPackageOfCurUnit = ecFirstLazarus + 602; ecAddCurUnitToPkg = ecFirstLazarus + 603; ecPackageGraph = ecFirstLazarus + 604; ecEditInstallPkgs = ecFirstLazarus + 605; ecConfigCustomComps = ecFirstLazarus + 606; // custom tools menu ecExtToolFirst = ecFirstLazarus + 700; ecExtToolLast = ecFirstLazarus + 799; // option commmands ecRunParameters = ecFirstLazarus + 800; ecCompilerOptions = ecFirstLazarus + 801; ecExtToolSettings = ecFirstLazarus + 802; ecConfigBuildLazarus = ecFirstLazarus + 803; ecEnvironmentOptions = ecFirstLazarus + 804; ecEditorOptions = ecFirstLazarus + 805; ecEditCodeTemplates = ecFirstLazarus + 806; ecCodeToolsOptions = ecFirstLazarus + 807; ecCodeToolsDefinesEd = ecFirstLazarus + 808; ecRescanFPCSrcDir = ecFirstLazarus + 809; // help menu ecAboutLazarus = ecFirstLazarus + 900; ecOnlineHelp = ecFirstLazarus + 901; ecConfigureHelp = ecFirstLazarus + 902; ecContextHelp = ecFirstLazarus + 903; // 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: 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 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; IDECmdScopeDesignerOnly: TIDECommandScope; IDECmdScopeObjctInspectorOnly: TIDECommandScope; // 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; 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'); IDECmdScopeDesignerOnly:=RegisterIDECommandScope('DesignerOnly'); IDECmdScopeObjctInspectorOnly:=RegisterIDECommandScope('ObjectInspectorOnly'); end; function CompareIDEShortCuts(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^.Key1integer(ShortCut2^.Shift1) then Result:=1 else if integer(ShortCut1^.Shift1)ShortCut2^.Key2 then Result:=1 else if ShortCut1^.Key2integer(ShortCut2^.Shift2) then Result:=1 else if integer(ShortCut1^.Shift2)ShortCut2^.Key1 then Result:=1 else if ShortCut1^.Key1integer(ShortCut2^.Shift1) then Result:=1 else if integer(ShortCut1^.Shift1)'' 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: String; TheCommand: word; const TheShortcutA, TheShortcutB: TIDEShortCut; const ExecuteMethod: TNotifyEvent; const ExecuteProc: TNotifyProcedure); begin fCommand:=TheCommand; fName:=TheName; 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; end.