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

rewrite confusing interface IEditableShortcut.

This commit is contained in:
Basile Burg 2020-03-08 21:38:05 +01:00
parent e335409c8f
commit 205c7bcfc1
6 changed files with 128 additions and 188 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
src/u_editor.pas
View File

@ -25,17 +25,17 @@ type
fNextPage: TShortCut;
fPrevPage: TShortCut;
fDetectModuleName: boolean;
fShCount: integer;
function optionedWantCategory(): string;
function optionedWantEditorKind: TOptionEditorKind;
function optionedWantContainer: TPersistent;
procedure optionedEvent(event: TOptionEditorEvent);
function optionedOptionsModified: boolean;
//
function scedWantFirst: boolean;
function scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
procedure scedSendItem(const category, identifier: string; aShortcut: TShortcut);
procedure scedSendDone;
function scedCount: integer;
function scedGetItem(const index: integer): TEditableShortcut;
procedure scedSetItem(const index: integer; constref item: TEditableShortcut);
published
property pageButtons: TPageControlButtons read fPageButtons write fPageButtons;
property pageOptions: TPageControlOptions read fPageOptions write fPageOptions;
@ -280,38 +280,35 @@ begin
exit(false);
end;
function TPagesOptions.scedWantFirst: boolean;
function TPagesOptions.scedCount: integer;
begin
fShCount := 0;
exit(true);
result := 4;
end;
function TPagesOptions.scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
function TPagesOptions.scedGetItem(const index: integer): TEditableShortcut;
begin
category := 'Editor pages';
case fShCount of
0: begin identifier := 'Select next page'; aShortcut:= fNextPage; end;
1: begin identifier := 'Select previous page'; aShortcut:= fPrevPage; end;
2: begin identifier := 'Move page left'; aShortcut:= fMoveLeft; end;
3: begin identifier := 'Move page right'; aShortcut:= fMoveRight; end;
end;
fShCount += 1;
result := fShCount <> 4;
end;
procedure TPagesOptions.scedSendItem(const category, identifier: string; aShortcut: TShortcut);
begin
case identifier of
'Select next page': fNextPage := aShortcut;
'Select previous page': fPrevPage := aShortcut;
'Move page left': fMoveLeft := aShortcut;
'Move page right': fMoveRight:= aShortcut;
result.category := 'Editor pages';
with result do
case index of
0: begin identifier := 'Select next page'; shortcut:= fNextPage; end;
1: begin identifier := 'Select previous page'; shortcut:= fPrevPage; end;
2: begin identifier := 'Move page left'; shortcut:= fMoveLeft; end;
3: begin identifier := 'Move page right'; shortcut:= fMoveRight; end;
else raise Exception.CreateFmt(
'unexpected TPagesOptions editable shortcut index: %d', [index]);
end;
end;
procedure TPagesOptions.scedSendDone;
procedure TPagesOptions.scedSetItem(const index: integer; constref item: TEditableShortcut);
begin
fShCount := 0;
case index of
0: fNextPage := item.shortcut;
1: fPrevPage := item.shortcut;
2: fMoveLeft := item.shortcut;
3: fMoveRight:= item.shortcut;
else raise Exception.CreateFmt(
'unexpected TPagesOptions editable shortcut index: %d', [index]);
end;
end;
{$ENDREGION}

69
src/u_editoroptions.pas
View File

@ -148,24 +148,22 @@ type
TEditorOptions = class(TEditorOptionsBase, IEditableOptions, IDocumentObserver, IEditableShortCut)
private
fBackup: TEditorOptionsBase;
fShortcutCount: Integer;
//
function optionedWantCategory(): string;
function optionedWantEditorKind: TOptionEditorKind;
function optionedWantContainer: TPersistent;
procedure optionedEvent(event: TOptionEditorEvent);
function optionedOptionsModified: boolean;
//
procedure docNew(document: TDexedMemo);
procedure docFocused(document: TDexedMemo);
procedure docChanged(document: TDexedMemo);
procedure docClosing(document: TDexedMemo);
//
function scedWantFirst: boolean;
function scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
procedure scedSendItem(const category, identifier: string; aShortcut: TShortcut);
procedure scedSendDone;
//
function scedCount: integer;
function scedGetItem(const index: integer): TEditableShortcut;
procedure scedSetItem(const index: integer; constref item: TEditableShortcut);
procedure applyChangeToEditor(anEditor: TDexedMemo);
protected
procedure afterLoad; override;
@ -571,56 +569,31 @@ end;
{$ENDREGION}
{$REGION IEditableShortCut ---------------------------------------------------}
function TEditorOptions.scedWantFirst: boolean;
function TEditorOptions.scedCount: integer;
begin
result := fShortCuts.Count > 0;
fShortcutCount := 0;
result := fShortCuts.Count;
end;
function TEditorOptions.scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
function TEditorOptions.scedGetItem(const index: integer): TEditableShortcut;
var
shrct: TPersistentShortcut;
s: TPersistentShortcut;
begin
shrct := TPersistentShortcut(fShortCuts.Items[fShortcutCount]);
category := 'Code editor';
identifier:= shrct.actionName;
s := TPersistentShortcut(fShortCuts.Items[index]);
result.category := 'Code editor';
result.identifier := s.actionName;
result.shortcut := s.shortcut;
// SynEdit shortcuts start with 'ec'
if identifier.length > 2 then
identifier := identifier[3..identifier.length];
aShortcut := shrct.shortcut;
fShortcutCount += 1;
result := fShortcutCount < fShortCuts.Count;
if result.identifier.length > 2 then
result.identifier := result.identifier[3..result.identifier.length];
end;
procedure TEditorOptions.scedSendItem(const category, identifier: string; aShortcut: TShortcut);
procedure TEditorOptions.scedSetItem(const index: integer; constref item: TEditableShortcut);
var
i: Integer;
shc: TPersistentShortcut;
s: TPersistentShortcut;
begin
if category <> 'Code editor' then
exit;
for i:= 0 to fShortCuts.Count-1 do
begin
shc := TPersistentShortcut(fShortCuts.Items[i]);
if shc.actionName.length > 2 then
begin
if shc.actionName[3..shc.actionName.length] <> identifier then
continue;
end else if shc.actionName <> identifier then
continue;
shc.shortcut:= aShortcut;
break;
end;
// note: shortcut modifications are not reversible,
// they are sent from another option editor.
s := TPersistentShortcut(fShortCuts.Items[index]);
s.shortcut := item.shortcut;
end;
procedure TEditorOptions.scedSendDone;
begin
applyChangesFromSelf;
end;
{$ENDREGION}
{$REGION IEditableOptions ----------------------------------------------------}

22
src/u_interfaces.pas
View File

@ -166,20 +166,26 @@ type
TProjectSubject = specialize TCustomSubject<IProjectObserver>;
(**
* Record used during communication between an IEditableShortCut and a TEditableShortCutSubject.
*)
TEditableShortcut = record
category: string;
identifier: string;
shortcut: TShortcut;
end;
(**
* An implementer can expose customizable shortcuts to be edited in a dedicated widget.
*)
IEditableShortCut = interface(IObserverType)
['IEditableShortCut']
// a TEditableShortCutSubject will start to collect shortcuts if result.
function scedWantFirst: boolean;
// a TEditableShortCutSubject collects the information on the shortcuts while result.
function scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
// a TEditableShortCutSubject sends the possibly modified shortcut.
procedure scedSendItem(const category, identifier: string; aShortcut: TShortcut);
// a TEditableShortCutSubject has finished to send the shortcuts.
procedure scedSendDone;
// a TEditableShortCutSubject requires the count of editable shortcuts.
function scedCount: integer;
// a TEditableShortCutSubject requires the nth editable shortcut.
function scedGetItem(const index: integer): TEditableShortcut;
// a TEditableShortCutSubject send the shortcut with a new key binding.
procedure scedSetItem(const index: integer; constref item: TEditableShortcut);
end;
(**
* An implementer manages its observers shortcuts.

44
src/u_main.pas
View File

@ -400,7 +400,6 @@ type
fFirstTimeRun: boolean;
fMultidoc: IMultiDocHandler;
fProcInputHandler: IProcInputHandler;
fScCollectCount: Integer;
fUpdateCount: NativeInt;
fProject: ICommonProject;
fFreeProj: ICommonProject;
@ -471,10 +470,9 @@ type
procedure projCompiled(project: ICommonProject; success: boolean);
// IEditableShortCut
function scedWantFirst: boolean;
function scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
procedure scedSendItem(const category, identifier: string; aShortcut: TShortcut);
procedure scedSendDone;
function scedCount: integer;
function scedGetItem(const index: integer): TEditableShortcut;
procedure scedSetItem(const index: integer; constref item: TEditableShortcut);
//Init - Fina
procedure InitImages;
@ -2524,39 +2522,27 @@ end;
{$ENDREGION}
{$REGION IEditableShortCut ---------------------------------------------------}
function TMainForm.scedWantFirst: boolean;
function TMainForm.scedCount: integer;
begin
fScCollectCount := 0;
result := true;
result := actions.ActionCount;
end;
function TMainForm.scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
function TMainForm.scedGetItem(const index: integer): TEditableShortcut;
var
act: TCustomAction;
a: TCustomAction;
begin
act := TCustomAction(Actions.Actions[fScCollectCount]);
category := act.Category;
identifier := act.Caption;
aShortcut := act.ShortCut;
fScCollectCount += 1;
result := fScCollectCount < actions.ActionCount;
a := TCustomAction(Actions.Actions[index]);
result.category := a.Category;
result.identifier := a.Caption;
result.shortcut := a.ShortCut;
end;
procedure TMainForm.scedSendItem(const category, identifier: string; aShortcut: TShortcut);
procedure TMainForm.scedSetItem(const index: integer; constref item: TEditableShortcut);
var
act: TCustomAction;
i: integer;
begin
for i:= 0 to Actions.ActionCount-1 do
begin
act := TCustomAction(Actions.Actions[i]);
if (act.Category = category) and (act.Caption = identifier) then
act.ShortCut := aShortcut;
end;
end;
procedure TMainForm.scedSendDone;
a: TCustomAction;
begin
a := TCustomAction(Actions.Actions[index]);
a.ShortCut:= item.shortcut;
end;
{$ENDREGION}

84
src/u_shortcutseditor.pas
View File

@ -13,17 +13,19 @@ uses
type
TShortcutItem = class(TCollectionItem)
private
strict private
fIdentifier: string;
fData: TShortcut;
fDeclarator: IEditableShortCut;
property declarator: IEditableShortCut read fDeclarator write fDeclarator;
fIndexInDecl: integer;
published
property identifier: string read fIdentifier write fIdentifier;
property data: TShortcut read fData write fData;
public
function combination: string;
procedure assign(source: TPersistent); override;
property declarator: IEditableShortCut read fDeclarator write fDeclarator;
property indexInDecl: integer read fIndexInDecl write fIndexInDecl;
end;
TShortCutCollection = class(TWritableLfmTextComponent)
@ -77,14 +79,14 @@ type
fHasChanged: boolean;
propvalue: TEditableShortcut;
fHasScaled: boolean;
//
procedure updateScaling;
function optionedWantCategory(): string;
function optionedWantEditorKind: TOptionEditorKind;
function optionedWantContainer: TPersistent;
procedure optionedEvent(event: TOptionEditorEvent);
function optionedOptionsModified: boolean;
//
function findCategory(const aName: string; aData: Pointer): TTreeNode;
function findCategory(const aShortcutItem: TShortcutItem): string;
function sortCategories(Cat1, Cat2: TTreeNode): integer;
@ -92,6 +94,7 @@ type
procedure updateEditCtrls;
procedure sendShortcuts;
function anItemIsSelected: boolean;
public
constructor create(TheOwner: TComponent); override;
destructor destroy; override;
@ -453,49 +456,43 @@ end;
procedure TShortcutEditor.receiveShortcuts;
var
i: Integer;
obs: IEditableShortCut;
cat: string;
sht: word;
idt: string;
itm: TShortcutItem;
i: integer;
j: integer;
o: IEditableShortCut;
s: TShortcutItem;
procedure addItem();
procedure addItem(constref item: u_interfaces.TEditableShortcut; const index: integer);
var
prt: TTreeNode;
begin
// root category
if cat.isEmpty or idt.isEmpty then
if item.category.isEmpty or item.identifier.isEmpty then
exit;
prt := findCategory(cat, obs);
prt := findCategory(item.category, o);
if prt.isNil then
prt := tree.Items.AddObject(nil, cat, obs);
prt := tree.Items.AddObject(nil, item.category, o);
// item as child
itm := TShortcutItem(fShortcuts.items.Add);
itm.identifier := idt;
itm.data:= sht;
itm.declarator := obs;
tree.Items.AddChildObject(prt, idt, itm);
cat := '';
idt := '';
s := TShortcutItem(fShortcuts.items.Add);
s.identifier := item.identifier;
s.data := item.shortcut;
s.declarator := o;
s.indexInDecl := index;
tree.Items.AddChildObject(prt, item.identifier, s);
end;
begin
tree.Items.Clear;
fShortcuts.items.Clear;
fBackup.items.Clear;
cat := '';
idt := '';
for i:= 0 to fObservers.observersCount-1 do
begin
obs := fObservers.observers[i] as IEditableShortCut;
if obs.scedWantFirst then
begin
while obs.scedWantNext(cat, idt, sht) do
addItem();
addItem();
end;
o := fObservers.observers[i] as IEditableShortCut;
for j:= 0 to o.scedCount-1 do
addItem(o.scedGetItem(j), j);
end;
tree.Items.SortTopLevelNodes(@sortCategories);
fBackup.Assign(fShortcuts);
end;
@ -503,25 +500,22 @@ end;
procedure TShortcutEditor.sendShortcuts;
var
i: integer;
shc: TShortcutItem;
decl: IEditableShortCut = nil;
cat: string;
s: TShortcutItem;
d: IEditableShortCut = nil;
c: string;
n: u_interfaces.TEditableShortcut;
begin
for i := 0 to fShortcuts.count-1 do
begin
shc := fShortcuts[i];
decl:= shc.declarator;
if decl = nil then
s := fShortcuts[i];
d := s.declarator;
c := findCategory(s);
if not assigned(d) or c.isEmpty() then
continue;
cat := findCategory(shc);
if cat.isEmpty then
continue;
decl.scedSendItem(cat, shc.identifier, shc.data);
if i = fShortcuts.count-1 then
decl.scedSendDone
// fShortcuts is always sorted by declarator, cf. receiveShortcuts()
else if decl <> fShortcuts[i+1].declarator then
decl.scedSendDone;
n.identifier:= s.identifier;
n.category := c;
n.shortcut := s.data;
d.scedSetItem(s.indexInDecl, n);
end;
end;
{$ENDREGION}

40
src/u_tools.pas
View File

@ -108,10 +108,10 @@ type
procedure projCompiling(project: ICommonProject);
procedure projCompiled(project: ICommonProject; success: boolean);
function scedWantFirst: boolean;
function scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
procedure scedSendItem(const category, identifier: string; aShortcut: TShortcut);
procedure scedSendDone;
function scedCount: integer;
function scedGetItem(const index: integer): TEditableShortcut;
procedure scedSetItem(const index: integer; constref item: TEditableShortcut);
published
property tools: TToolItems read fTools write setTools;
property readOnly: boolean read fReadOnly write fReadOnly;
@ -375,37 +375,21 @@ end;
{$ENDREGION}
{$REGION IEditableShortCut -----------------------------------------------------}
function TTools.scedWantFirst: boolean;
function TTools.scedCount: integer;
begin
result := fTools.Count > 0;
fShctCount := 0;
result := fTools.Count;
end;
function TTools.scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
function TTools.scedGetItem(const index: integer): TEditableShortcut;
begin
category := 'Tools';
identifier:= tool[fShctCount].toolAlias;
aShortcut := tool[fShctCount].shortcut;
fShctCount += 1;
result := fShctCount < fTools.Count;
result.category := 'Tools';
result.identifier := tool[index].toolAlias;
result.shortcut := tool[index].shortcut;
end;
procedure TTools.scedSendItem(const category, identifier: string; aShortcut: TShortcut);
var
i: Integer;
begin
if category <> 'Tools' then
exit;
for i := 0 to tools.Count-1 do if tool[i].toolAlias = identifier then
begin
tool[i].shortcut := aShortcut;
break;
end;
end;
procedure TTools.scedSendDone;
procedure TTools.scedSetItem(const index: integer; constref item: TEditableShortcut);
begin
tool[index].shortcut := item.shortcut;
end;
{$ENDREGION}