forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

#107, simplify access to main menu with a single service

This commit is contained in:
Basile Burg 2016-11-27 08:13:15 +01:00
parent 7b39f9d5e6
commit f654811f37
No known key found for this signature in database
GPG Key ID: 1868039F415CB8CF
6 changed files with 120 additions and 282 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
src/ce_gdb.pas
View File

@ -315,7 +315,7 @@ type
TAddWatchPointKind = (wpkRead, wpkWrite, wpkReadWrite);
{ TCEGdbWidget }
TCEGdbWidget = class(TCEWidget, ICEProjectObserver, ICEDocumentObserver, ICEDebugger, ICEMainMenuProvider)
TCEGdbWidget = class(TCEWidget, ICEProjectObserver, ICEDocumentObserver, ICEDebugger)
btnContinue: TCEToolButton;
btnVariables: TCEToolButton;
btnNext: TCEToolButton;
@ -373,7 +373,6 @@ type
fOutputName: string;
fInputName: string;
fShowFromCustomCommand: boolean;
fUpdateMenu: boolean;
fGdbState: TGdbState;
fSubj: TCEDebugObserverSubject;
fDoc: TCESynMemo;
@ -392,12 +391,9 @@ type
fOptions: TCEDebugOptions;
fAddWatchPointKind: TAddWatchPointKind;
fBreakPoints: TPersistentBreakPoints;
//
fMenu: TMenuItem;
procedure updateMenu;
procedure optionsChangesApplied(sender: TObject);
procedure menuDeclare(item: TMenuItem);
procedure menuUpdate(item: TMenuItem);
function menuHasItems: boolean;
//
procedure disableEditor;
procedure setState(value: TGdbState);
procedure updateButtonsState;
@ -951,6 +947,7 @@ begin
fAddWatchPointKind := wpkWrite;
fBreakPoints := TPersistentBreakPoints.create(self);
//
updateMenu;
AssignPng(btnSendCom, 'ACCEPT');
setState(gsNone);
end;
@ -976,157 +973,136 @@ begin
btnSendCom.Flat:=value;
end;
procedure TCEGdbWidget.menuDeclare(item: TMenuItem);
procedure TCEGdbWidget.updateMenu;
var
mnu: ICEMainMenu;
itm: TMenuItem;
bmp: TBitmap;
i: integer;
begin
item.Caption:='Debugger';
item.Clear;
mnu := getMainMenu;
if not assigned(mnu) then
exit;
if fMenu.isNil then
begin
fMenu := mnu.mnuAdd;
fMenu.Caption:='Debugger';
end;
fMenu.Clear;
bmp := TBitmap.Create;
itm := TMenuItem.Create(item);
itm := TMenuItem.Create(fMenu);
itm.ShortCut:=fOptions.shortcuts.start;
itm.Caption:='Start';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=0;
item.Add(itm);
fMenu.Add(itm);
btnStart.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
i := fMenu.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm := TMenuItem.Create(fMenu);
itm.ShortCut:=fOptions.shortcuts.stop;
itm.Caption:='Stop';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=1;
item.Add(itm);
fMenu.Add(itm);
btnStop.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
i := fMenu.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm := TMenuItem.Create(fMenu);
itm.ShortCut:=fOptions.shortcuts.pause;
itm.Caption:='Pause';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=2;
item.Add(itm);
fMenu.Add(itm);
btnPause.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
i := fMenu.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm := TMenuItem.Create(fMenu);
itm.ShortCut:=fOptions.shortcuts.continue;
itm.Caption:='Continue';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=3;
item.Add(itm);
fMenu.Add(itm);
btnContinue.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
i := fMenu.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm := TMenuItem.Create(fMenu);
itm.ShortCut:=fOptions.shortcuts.step;
itm.Caption:='Step';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=4;
item.Add(itm);
fMenu.Add(itm);
btnNext.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
i := fMenu.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm := TMenuItem.Create(fMenu);
itm.ShortCut:=fOptions.shortcuts.stepOver;
itm.Caption:='Step over';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=5;
item.Add(itm);
fMenu.Add(itm);
btnOver.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
i := fMenu.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm := TMenuItem.Create(fMenu);
itm.Caption:= '-';
itm.Tag:=-1;
item.Add(itm);
fMenu.Add(itm);
itm := TMenuItem.Create(item);
itm := TMenuItem.Create(fMenu);
itm.ShortCut:=fOptions.shortcuts.updateRegisters;
itm.Caption:='Update registers';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=6;
item.Add(itm);
fMenu.Add(itm);
btnReg.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
i := fMenu.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm := TMenuItem.Create(fMenu);
itm.ShortCut:=fOptions.shortcuts.updateStack;
itm.Caption:='Update call stack';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=7;
item.Add(itm);
fMenu.Add(itm);
btnStack.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
i := fMenu.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
itm := TMenuItem.Create(item);
itm := TMenuItem.Create(fMenu);
itm.ShortCut:=fOptions.shortcuts.updateVariables;
itm.Caption:='Update the variables';
itm.OnClick:= @executeFromShortcut;
itm.Tag:=8;
item.Add(itm);
fMenu.Add(itm);
btnVariables.toBitmap(bmp);
itm.Bitmap.Assign(bmp);
i := item.GetImageList.Add(bmp, nil);
i := fMenu.GetImageList.Add(bmp, nil);
itm.ImageIndex:= i;
bmp.Free;
end;
procedure TCEGdbWidget.menuUpdate(item: TMenuItem);
var
i: integer;
itm: TMenuItem;
begin
if item.isNil or not fUpdateMenu then
exit;
fUpdateMenu := false;
for i:= 0 to item.Count-1 do
begin
itm := item.Items[i];
case itm.Tag of
0: itm.ShortCut:=fOptions.shortcuts.start;
1: itm.ShortCut:=fOptions.shortcuts.stop;
2: itm.ShortCut:=fOptions.shortcuts.pause;
3: itm.ShortCut:=fOptions.shortcuts.continue;
4: itm.ShortCut:=fOptions.shortcuts.step;
5: itm.ShortCut:=fOptions.shortcuts.stepOver;
6: itm.ShortCut:=fOptions.shortcuts.updateRegisters;
7: itm.ShortCut:=fOptions.shortcuts.updateStack;
8: itm.ShortCut:=fOptions.shortcuts.updateVariables;
end;
end;
end;
function TCEGdbWidget.menuHasItems: boolean;
begin
exit(true);
end;
procedure TCEGdbWidget.optionsChangesApplied(sender: TObject);
begin
fUpdateMenu:=true;
updateMenu;
end;
procedure TCEGdbWidget.executeFromShortcut(sender: TObject);

75
src/ce_interfaces.pas
View File

@ -163,47 +163,6 @@ type
(**
* An implementer can add a main menu entry.
*)
ICEMainMenuProvider = interface(IObserverType)
['ICEMainMenuProvider']
// item is a new mainMenu entry. item must be filled with the sub-items to be added.
procedure menuDeclare(item: TMenuItem);
// item is the mainMenu entry declared previously. the sub items can be updated, deleted.
procedure menuUpdate(item: TMenuItem);
// indicates if menuDeclare should be called.
function menuHasItems: boolean;
end;
(**
* An implementer collects and updates its observers menus.
*)
TCEMainMenuSubject = specialize TCECustomSubject<ICEMainMenuProvider>;
(**
* An implementer declares some actions which have their own main menu entry and
* whose shortcuts are automatically handled
*)
ICEActionProvider = interface(IObserverType)
['ICEActionProvider']
// the action handler will clear the references to the actions collected previously and start collecting if result.
function actHandlerWantRecollect: boolean;
// the action handler starts to collect the actions if result.
function actHandlerWantFirst: boolean;
// the handler continue collecting action if result.
function actHandlerWantNext(out category: string; out action: TCustomAction): boolean;
// the handler update the state of a particular action.
procedure actHandleUpdater(action: TCustomAction);
end;
(**
* An implementer handles its observers actions.
*)
TCEActionProviderSubject = specialize TCECustomSubject<ICEActionProvider>;
(**
* An implementer can expose customizable shortcuts to be edited in a dedicated widget.
*)
@ -402,6 +361,16 @@ type
procedure getCompilerImports(value: DCompiler; paths: TStrings);
end;
(**
* Single service that provides access to the main menu.
*)
ICEMainMenu = interface(ICESingleService)
// adds a main menu entry
function mnuAdd: TMenuItem;
// removes a main menu entry
procedure mnuDelete(value: TMenuItem);
end;
TDCDCompletionKind = (
dckClass,
@ -454,15 +423,16 @@ type
{
Service getters:
}
function getMessageDisplay(var obj: ICEMessagesDisplay): ICEMessagesDisplay;
function getMessageDisplay: ICEMessagesDisplay;
function getprocInputHandler: ICEProcInputHandler;
function getMultiDocHandler: ICEMultiDocHandler;
function getSymStringExpander: ICESymStringExpander;
function getProjectGroup: ICEProjectGroup;
function getExplorer: ICEExplorer;
function getOptionsEditor: ICEOptionsEditor;
function getCompilerSelector: ICECompilerSelector;
function getMessageDisplay(var obj: ICEMessagesDisplay): ICEMessagesDisplay; inline;
function getMessageDisplay: ICEMessagesDisplay; inline;
function getprocInputHandler: ICEProcInputHandler; inline;
function getMultiDocHandler: ICEMultiDocHandler; inline;
function getSymStringExpander: ICESymStringExpander; inline;
function getProjectGroup: ICEProjectGroup; inline;
function getExplorer: ICEExplorer; inline;
function getOptionsEditor: ICEOptionsEditor; inline;
function getCompilerSelector: ICECompilerSelector; inline;
function getMainMenu: ICEMainMenu; inline;
implementation
@ -612,6 +582,11 @@ function getCompilerSelector: ICECompilerSelector;
begin
exit(EntitiesConnector.getSingleService('ICECompilerSelector') as ICECompilerSelector);
end;
function getMainMenu: ICEMainMenu;
begin
exit(EntitiesConnector.getSingleService('ICEMainMenu') as ICEMainMenu);
end;
{$ENDREGION}
end.

2
src/ce_main.lfm
View File

@ -4801,8 +4801,8 @@ object CEMainForm: TCEMainForm
end
object Actions: TActionList
Images = imgList
OnUpdate = ActionsUpdate
left = 32
top = 1
object actEdCopy: TAction
Category = 'Edit'
Caption = 'Copy'

147
src/ce_main.pas
View File

@ -77,7 +77,7 @@ type
end;
{ TCEMainForm }
TCEMainForm = class(TForm, ICEDocumentObserver, ICEEditableShortCut, ICEProjectObserver)
TCEMainForm = class(TForm, ICEDocumentObserver, ICEEditableShortCut, ICEProjectObserver, ICEMainMenu)
actFileCompAndRun: TAction;
actFileSaveAll: TAction;
actFileClose: TAction;
@ -298,7 +298,6 @@ type
procedure actProjCompileExecute(Sender: TObject);
procedure actEdCopyExecute(Sender: TObject);
procedure actEdCutExecute(Sender: TObject);
procedure ActionsUpdate(AAction: TBasicAction; var Handled: Boolean);
procedure actEdMacPlayExecute(Sender: TObject);
procedure actEdMacStartStopExecute(Sender: TObject);
procedure actFileNewExecute(Sender: TObject);
@ -338,7 +337,6 @@ type
fDscanUnittests: boolean;
fDoc: TCESynMemo;
fFirstTimeCoedit: boolean;
fActionHandler: TCEActionProviderSubject;
fMultidoc: ICEMultiDocHandler;
fScCollectCount: Integer;
fUpdateCount: NativeInt;
@ -379,18 +377,18 @@ type
fInitialized: boolean;
fRunProc: TCEProcess;
fMsgs: ICEMessagesDisplay;
fMainMenuSubj: TCEMainMenuSubject;
fAppliOpts: TCEApplicationOptions;
fProjActionsLock: boolean;
fCompilerSelector: ICECompilerSelector;
procedure updateMainMenuProviders;
procedure updateFloatingWidgetOnTop(onTop: boolean);
procedure widgetDockingChanged(sender: TCEWidget; newState: TWidgetDockingState);
procedure mnuOptsItemClick(sender: TObject);
// action provider handling;
procedure clearActProviderEntries;
procedure collectedActProviderEntries;
// ICEMainMenu
function singleServiceName: string;
function mnuAdd: TMenuItem;
procedure mnuDelete(value: TMenuItem);
// ICEDocumentObserver
procedure docNew(document: TCESynMemo);
@ -1126,11 +1124,10 @@ end;
constructor TCEMainForm.create(aOwner: TComponent);
begin
inherited create(aOwner);
fMainMenuSubj := TCEMainMenuSubject.create;
fActionHandler := TCEActionProviderSubject.create;
fOptionCategories := TCEEditableOptionsSubject.create;
EntitiesConnector.addObserver(self);
EntitiesConnector.addSingleService(self);
InitMRUs;
InitWidgets;
@ -1141,7 +1138,6 @@ begin
OnDragDrop:= @ddHandler.DragDrop;
OnDragOver:= @ddHandler.DragOver;
updateMainMenuProviders;
EntitiesConnector.forceUpdate;
fSymStringExpander:= getSymStringExpander;
fProjectGroup := getProjectGroup;
@ -1810,8 +1806,6 @@ begin
fPrjGrpMru.Free;
FreeRunnableProc;
//
fMainMenuSubj.Free;
fActionHandler.Free;
fOptionCategories.Free;
EntitiesConnector.removeObserver(self);
inherited;
@ -1873,66 +1867,6 @@ begin
TAction(sender).Enabled := false;
end;
procedure TCEMainForm.ActionsUpdate(AAction: TBasicAction; var Handled: Boolean);
begin
Handled := false;
if fUpdateCount > 0 then
exit;
Inc(fUpdateCount);
try
clearActProviderEntries;
collectedActProviderEntries;
if AAction.isNotNil and not AAction.Update then
TAction(AAction).enabled := true;
updateMainMenuProviders;
finally
Dec(fUpdateCount);
end;
end;
procedure TCEMainForm.updateMainMenuProviders;
var
i, j: Integer;
itm: TMenuItem;
hasItems: boolean;
doneUpdate: boolean;
begin
if not assigned(mainMenu.Images) then
exit;
for j := 0 to fMainMenuSubj.observersCount-1 do
begin
doneUpdate := false;
hasItems := (fMainMenuSubj.observers[j] as ICEMainMenuProvider).menuHasItems;
// try to update existing entry.
for i := mainMenu.Items.Count-1 downto 0 do
if PtrInt(fMainMenuSubj.observers[j]) = mainMenu.Items[i].Tag then
begin
if not hasItems then
begin
doneUpdate:=true;
mainMenu.Items[i].Clear;
mainMenu.Items.Delete(i);
break;
end
else
begin
(fMainMenuSubj.observers[j] as ICEMainMenuProvider).menuUpdate(mainMenu.Items[i]);
doneUpdate := true;
break;
end;
end;
if doneUpdate or not hasItems then
continue;
// otherwise propose to create a new entry
itm := TMenuItem.Create(Self);
mainMenu.Items.Add(itm);
(fMainMenuSubj.observers[j] as ICEMainMenuProvider).menuDeclare(itm);
itm.Tag:= PtrInt(fMainMenuSubj.observers[j]);
if itm.Count = 0 then
itm.Free;
end;
end;
procedure TCEMainForm.mruChange(Sender: TObject);
var
srcLst: TCEMruFileList;
@ -2152,55 +2086,28 @@ begin
end;
{$ENDREGION}
{$REGION TCEActionProviderHandler ----------------------------------------------}
procedure TCEMainForm.clearActProviderEntries;
{$REGION ICEMAinMenu -----------------------------------------------------------}
function TCEMainForm.singleServiceName: string;
begin
exit('ICEMainMenu');
end;
function TCEMainForm.mnuAdd: TMenuItem;
begin
result := TMenuItem.Create(nil);
mainMenu.Items.Add(result);
exit(result);
end;
procedure TCEMainForm.mnuDelete(value: TMenuItem);
var
prov: ICEActionProvider;
act: TContainedAction;
i, j: Integer;
i: integer;
begin
for i:= 0 to fActionHandler.observersCount-1 do
begin
prov := fActionHandler[i] as ICEActionProvider;
if not prov.actHandlerWantRecollect then
continue;
for j := Actions.ActionCount-1 downto 0 do
begin
act := Actions.Actions[j];
if (act.Owner <> Self) and (act.Tag = PtrInt(prov)) then
act.ActionList := nil;
end;
end;
end;
procedure TCEMainForm.collectedActProviderEntries;
var
prov: ICEActionProvider;
act: TCustomAction;
cat: string;
i: Integer;
procedure addAction;
begin
act.ActionList := Actions;
act.Tag := ptrInt(prov);
act.Category := cat;
act := nil;
cat := '';
end;
begin
for i:= 0 to fActionHandler.observersCount-1 do
begin
prov := fActionHandler[i] as ICEActionProvider;
if not prov.actHandlerWantFirst then
continue;
act := nil;
cat := '';
while prov.actHandlerWantNext(cat, act) do
addAction;
addAction;
end;
if value.isNil then
exit;
i := mainMenu.Items.IndexOf(value);
if i <> -1 then
mainMenu.Items.Delete(i);
end;
{$ENDREGION}

62
src/ce_tools.pas
View File

@ -66,17 +66,15 @@ type
function findTool(const value: string): TCEToolItem;
end;
TCETools = class(TWritableLfmTextComponent, ICEMainMenuProvider, ICEEditableShortcut, ICEDocumentObserver)
TCETools = class(TWritableLfmTextComponent, ICEEditableShortcut, ICEDocumentObserver)
private
fTools: TCEToolItems;
fShctCount: Integer;
fDoc: TCESynMemo;
fMenu: TMenuItem;
function getTool(index: Integer): TCEToolItem;
procedure setTools(value: TCEToolItems);
//
procedure menuDeclare(item: TMenuItem);
procedure menuUpdate(item: TMenuItem);
function menuHasItems: boolean;
procedure executeToolFromMenu(sender: TObject);
//
procedure docNew(document: TCESynMemo);
@ -94,6 +92,7 @@ type
constructor create(aOwner: TComponent); override;
destructor destroy; override;
//
procedure updateMenu;
function addTool: TCEToolItem;
procedure executeTool(tool: TCEToolItem); overload;
procedure executeTool(index: Integer); overload;
@ -290,60 +289,37 @@ end;
{$ENDREGION}
{$REGION ICEMainMenuProvider ---------------------------------------------------}
procedure TCETools.executeToolFromMenu(sender: TObject);
begin
executeTool(TCEToolItem(TMenuItem(sender).tag));
end;
procedure TCETools.menuDeclare(item: TMenuItem);
procedure TCETools.updateMenu;
var
i: Integer;
mnu: ICEMainMenu = nil;
itm: TMenuItem;
colitm: TCEToolItem;
i: integer;
begin
if tools.Count = 0 then exit;
//
item.Caption := 'Custom tools';
item.Clear;
if fMenu.isNil then
begin
mnu := getMainMenu;
if not assigned(mnu) then
exit;
fMenu := mnu.mnuAdd;
fMenu.Caption:='Custom tools';
end;
fMenu.Clear;
for i := 0 to tools.Count-1 do
begin
colitm := tool[i];
//
itm := TMenuItem.Create(item);
itm := TMenuItem.Create(fMenu);
itm.ShortCut:= colitm.shortcut;
itm.Caption := colitm.toolAlias;
itm.tag := ptrInt(colitm);
itm.onClick := @executeToolFromMenu;
item.add(itm);
fMenu.add(itm);
end;
end;
procedure TCETools.menuUpdate(item: TMenuItem);
var
i: Integer;
colitm: TCEToolItem;
mnuitm: TMenuItem;
procedure TCETools.executeToolFromMenu(sender: TObject);
begin
if item.isNil then exit;
if item.Count <> tools.Count then
menuDeclare(item)
else for i:= 0 to tools.Count-1 do
begin
colitm := tool[i];
mnuitm := item.Items[i];
//
if mnuitm.Tag <> ptrInt(colitm) then
mnuitm.Tag := ptrInt(colitm);
if mnuitm.Caption <> colitm.toolAlias then
mnuitm.Caption := colitm.toolAlias;
if mnuitm.shortcut <> colitm.shortcut then
mnuitm.shortcut := colitm.shortcut;
end;
end;
function TCETools.menuHasItems: boolean;
begin
result := tools.Count <> 0;
executeTool(TCEToolItem(TMenuItem(sender).tag));
end;
{$ENDREGION}

6
src/ce_toolseditor.pas
View File

@ -48,6 +48,7 @@ constructor TCEToolsEditorWidget.create(aOwner: TComponent);
begin
inherited;
propsEd.CheckboxForBoolean := true;
propsEd.PropertyEditorHook.AddHandlerModified(@propsEdModified);
rebuildToolList;
end;
@ -68,6 +69,7 @@ begin
lstTools.AddItem(CustomTools[i].toolAlias, nil);
if lstTools.Count > 0 then
lstTools.ItemIndex := 0;
CustomTools.updateMenu;
end;
procedure TCEToolsEditorWidget.updateToolList;
@ -76,6 +78,7 @@ var
begin
for i := 0 to CustomTools.tools.Count-1 do
lstTools.Items[i] := CustomTools[i].toolAlias;
CustomTools.updateMenu;
end;
procedure TCEToolsEditorWidget.lstToolsSelectionChange(Sender: TObject;
@ -90,7 +93,8 @@ procedure TCEToolsEditorWidget.propsEdModified(Sender: TObject);
begin
if propsEd.ItemIndex = -1 then
exit;
if propsEd.Rows[propsEd.ItemIndex].Name = 'toolAlias' then
if (propsEd.Rows[propsEd.ItemIndex].Name = 'toolAlias')
or (propsEd.Rows[propsEd.ItemIndex].Name = 'shortcut') then
updateToolList;
end;