Merge branch 'a12_2_a13'

This commit is contained in:
Basile Burg 2015-02-21 06:21:00 +01:00
commit b46259c195
8 changed files with 363 additions and 38 deletions

View File

@ -140,7 +140,7 @@
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item6> </Item6>
</RequiredPackages> </RequiredPackages>
<Units Count="36"> <Units Count="37">
<Unit0> <Unit0>
<Filename Value="coedit.lpr"/> <Filename Value="coedit.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -366,6 +366,13 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="ce_dockoptions"/> <UnitName Value="ce_dockoptions"/>
</Unit35> </Unit35>
<Unit36>
<Filename Value="..\src\ce_shortcutseditor.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="CEShortcutEditor"/>
<ResourceBaseClass Value="Frame"/>
<UnitName Value="ce_shortcutseditor"/>
</Unit36>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

View File

@ -6,9 +6,10 @@ uses
{$IFDEF UNIX}{$IFDEF UseCThreads} {$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads, cthreads,
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_observer, ce_libman, Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_observer,
ce_tools, ce_dcd, ce_main, ce_writableComponent, ce_options, ce_symstring, ce_libman, ce_tools, ce_dcd, ce_main, ce_writableComponent, ce_options,
ce_staticmacro, ce_inspectors, LResources, ce_editoroptions, ce_dockoptions; ce_symstring, ce_staticmacro, ce_inspectors, LResources, ce_editoroptions,
ce_dockoptions, ce_shortcutseditor;
{$R *.res} {$R *.res}

View File

@ -67,7 +67,7 @@ end;
function TEditableAnchorDockOptions.optionedWantEditorKind: TOptionEditorKind; function TEditableAnchorDockOptions.optionedWantEditorKind: TOptionEditorKind;
begin begin
exit(oekForm); exit(oekControl);
end; end;
function TEditableAnchorDockOptions.optionedWantContainer: TPersistent; function TEditableAnchorDockOptions.optionedWantContainer: TPersistent;

View File

@ -11,7 +11,7 @@ uses
type type
(** (**
* An implementer can save and load some stuffs on application start/quit * An implementer can save and load some stuffs when Coedit starts/quits
*) *)
ICESessionOptionsObserver = interface ICESessionOptionsObserver = interface
['ICESessionOptionsObserver'] ['ICESessionOptionsObserver']
@ -122,14 +122,13 @@ type
*) *)
ICEEditableShortCut = interface ICEEditableShortCut = interface
['ICEEditableShortCut'] ['ICEEditableShortCut']
// a TCEEditableShortCutSubject queries the editable shortcuts count. // a TCEEditableShortCutSubject will start to collect shortcuts if result
procedure scGetCount(out aValue: Integer); function scedWantFirst: boolean;
// a TCEEditableShortCutSubject queries the shortcut category name. // a TCEEditableShortCutSubject collects the information on the shortcuts while result
procedure scGetCategory(out aValue: string); function scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
// a TCEEditableShortCutSubject queries the state of the index-th shortcut. // a TCEEditableShortCutSubject sends the possibly modified shortcut
procedure scGetItem(index: Integer; out aName: string; out aShortcut: Word); procedure scedSendItem(const category, identifier: string; aShortcut: TShortcut);
// a TCEEditableShortCutSubject sends the possibly modified assignation of the index-th shortcut.
procedure scSetItem(index: Integer; const aCategory, aName: string; aShortcut: Word);
end; end;
(** (**
* An implementer manages its observers shortcuts. * An implementer manages its observers shortcuts.
@ -140,21 +139,23 @@ type
end; end;
// the option editor uses this value as a hint to cast and display an option container.
TOptionEditorKind = (oekGeneric, oekForm); TOptionEditorKind = (oekGeneric, oekForm, oekControl);
// event generated by the option editor and passed to an ICEEditableOptions.
// the oeeChange event only happends if the container is oekGeneric.
TOptionEditorEvent = (oeeCancel, oeeAccept, oeeChange); TOptionEditorEvent = (oeeCancel, oeeAccept, oeeChange);
(** (**
* An implementer can expose some options to be edited in a dedicated widget. * An implementer can expose some options to be edited in a dedicated widget.
*) *)
ICEEditableOptions = interface ICEEditableOptions = interface
['ICEEditableOptions'] ['ICEEditableOptions']
// the widget wants the category // the widget wants the category.
function optionedWantCategory(): string; function optionedWantCategory(): string;
// the widget wants to know if the options will use a generic editor or a custom form // the widget wants to know if the options will use a generic editor or a custom form.
function optionedWantEditorKind: TOptionEditorKind; function optionedWantEditorKind: TOptionEditorKind;
// the widget wants the custom option editor form or the TPersistent containing the options // the widget wants the custom option editor TCustomForm, TWinControl or the TPersistent containing the options.
function optionedWantContainer: TPersistent; function optionedWantContainer: TPersistent;
// the option editor informs that something has happened // the option editor informs that something has happened.
procedure optionedEvent(anEvent: TOptionEditorEvent); procedure optionedEvent(anEvent: TOptionEditorEvent);
end; end;
(** (**
@ -167,39 +168,39 @@ type
/// describes the message kind, when Auto implies that a ICELogMessageObserver guess the kind. /// describes the message kind, 'amkAuto' implies that an ICELogMessageObserver guess the kind.
TCEAppMessageKind = (amkAuto, amkBub, amkInf, amkHint, amkWarn, amkErr); TCEAppMessageKind = (amkAuto, amkBub, amkInf, amkHint, amkWarn, amkErr);
/// describes the message context. Used by a ICELogMessageObserver to filter the messages. /// describes the message context. Used by a ICELogMessageObserver to filter the messages.
TCEAppMessageCtxt = (amcAll, amcEdit, amcProj, amcApp, amcMisc); TCEAppMessageCtxt = (amcAll, amcEdit, amcProj, amcApp, amcMisc);
(** (**
* Single service given by the messages widget. * Single service provided by the messages widget.
*) *)
ICEMessagesDisplay = interface(ICESingleService) ICEMessagesDisplay = interface(ICESingleService)
// display a message // displays a message
procedure message(const aValue: string; aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind); procedure message(const aValue: string; aData: Pointer; aCtxt: TCEAppMessageCtxt; aKind: TCEAppMessageKind);
// clear the messages related to the context aCtxt. // clears the messages related to the context aCtxt.
procedure clearByContext(aCtxt: TCEAppMessageCtxt); procedure clearByContext(aCtxt: TCEAppMessageCtxt);
// clear the messages related to the data aData. // clears the messages related to the data aData.
procedure clearByData(aData: Pointer); procedure clearByData(aData: Pointer);
end; end;
(** (**
* Single service given by the process-input widget. * Single service provided by the process-input widget.
*) *)
ICEProcInputHandler = interface(ICESingleService) ICEProcInputHandler = interface(ICESingleService)
// add an entry to the list of process which can receive an user input // add an entry to the list of process which can receive an user input.
procedure addProcess(aProcess: TProcess); procedure addProcess(aProcess: TProcess);
// remove an entry // remove an entry.
procedure removeProcess(aProcess: TProcess); procedure removeProcess(aProcess: TProcess);
end; end;
(** (**
* Single service related to the collection of document * Single service related to the documents as a collection.
*) *)
ICEMultiDocHandler = interface(ICESingleService) ICEMultiDocHandler = interface(ICESingleService)
// returns the count of opened document // returns the count of opened document
@ -218,7 +219,7 @@ type
{ {
subject Primitives: subject primitives:
A subject cannot necessarly provides all the informations the observers expect. A subject cannot necessarly provides all the informations the observers expect.
It can compose using the following "primitives". It can compose using the following "primitives".
@ -251,7 +252,6 @@ type
{ {
Service getters: Service getters:
Lazily get the interface of a service when needed or for a punctual usage.
The first overload assign the variable only when not yet set, the second is The first overload assign the variable only when not yet set, the second is
designed for a punctual usage, for example if a widget needs the service in designed for a punctual usage, for example if a widget needs the service in
a single and rarely called method. a single and rarely called method.

View File

@ -17,9 +17,8 @@ uses
type type
// TODO-cfeature: options // TODO-cfeature: options
// TODO-cwidget: options editor
TCEMainForm = class(TForm, ICEMultiDocObserver, ICESessionOptionsObserver) TCEMainForm = class(TForm, ICEMultiDocObserver, ICESessionOptionsObserver, ICEEditableShortCut)
actFileCompAndRun: TAction; actFileCompAndRun: TAction;
actFileSaveAll: TAction; actFileSaveAll: TAction;
actFileClose: TAction; actFileClose: TAction;
@ -180,6 +179,7 @@ type
fDoc: TCESynMemo; fDoc: TCESynMemo;
fMultidoc: ICEMultiDocHandler; fMultidoc: ICEMultiDocHandler;
fScCollectCount: Integer;
fUpdateCount: NativeInt; fUpdateCount: NativeInt;
fProject: TCEProject; fProject: TCEProject;
fProjMru: TMruFileList; fProjMru: TMruFileList;
@ -215,6 +215,11 @@ type
procedure docFocused(aDoc: TCESynMemo); procedure docFocused(aDoc: TCESynMemo);
procedure docChanged(aDoc: TCESynMemo); procedure docChanged(aDoc: TCESynMemo);
// ICEEditableShortcut
function scedWantFirst: boolean;
function scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
procedure scedSendItem(const category, identifier: string; aShortcut: TShortcut);
// ICESessionOptionsObserver // ICESessionOptionsObserver
procedure sesoptBeforeSave; procedure sesoptBeforeSave;
procedure sesoptDeclareProperties(aFiler: TFiler); procedure sesoptDeclareProperties(aFiler: TFiler);
@ -900,6 +905,35 @@ begin
end; end;
{$ENDREGION} {$ENDREGION}
{$REGION ICEEditableShortCut}
function TCEMainForm.scedWantFirst: boolean;
begin
fScCollectCount := 0;
result := true;
end;
function TCEMainForm.scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
var
act: TCustomAction;
begin
result := false;
if fScCollectCount > actions.ActionCount -1 then exit;
//
act := TCustomAction(Actions.Actions[fScCollectCount]);
category := act.Category;
identifier := act.Caption;
aShortcut := act.ShortCut;
//
fScCollectCount += 1;
result := true;
end;
procedure TCEMainForm.scedSendItem(const category, identifier: string; aShortcut: TShortcut);
begin
end;
{$ENDREGION}
{$REGION file ------------------------------------------------------------------} {$REGION file ------------------------------------------------------------------}
procedure TCEMainForm.actFileHtmlExportExecute(Sender: TObject); procedure TCEMainForm.actFileHtmlExportExecute(Sender: TObject);
var var

View File

@ -119,12 +119,17 @@ begin
dt := PCategoryData(selCat.Selected.Data); dt := PCategoryData(selCat.Selected.Data);
if dt^.container = nil then exit; if dt^.container = nil then exit;
case dt^.kind of case dt^.kind of
oekControl:
begin
TWinControl(dt^.container).Parent := pnlEd;
TWinControl(dt^.container).Align := alClient;
end;
oekForm: oekForm:
begin begin
TForm(dt^.container).Parent := pnlEd; TCustomForm(dt^.container).Parent := pnlEd;
TForm(dt^.container).Align := alClient; TCustomForm(dt^.container).Align := alClient;
//TForm(dt^.container).BorderIcons:= []; TCustomForm(dt^.container).BorderIcons:= [];
//TForm(dt^.container).BorderStyle:= bsNone; TCustomForm(dt^.container).BorderStyle:= bsNone;
end; end;
oekGeneric: oekGeneric:
begin begin

View File

@ -0,0 +1,56 @@
object CEShortcutEditor: TCEShortcutEditor
Left = 0
Height = 471
Top = 0
Width = 431
ClientHeight = 471
ClientWidth = 431
TabOrder = 0
DesignLeft = 796
DesignTop = 213
object Panel1: TPanel
Left = 0
Height = 471
Top = 0
Width = 431
Align = alClient
BevelOuter = bvNone
ClientHeight = 471
ClientWidth = 431
TabOrder = 0
object fltItems: TTreeFilterEdit
Left = 0
Height = 23
Top = 0
Width = 407
ButtonWidth = 23
NumGlyphs = 1
Align = alCustom
Anchors = [akTop, akLeft, akRight]
MaxLength = 0
TabOrder = 0
FilteredTreeview = tree
end
object tree: TTreeView
Left = 1
Height = 389
Top = 28
Width = 430
Align = alCustom
Anchors = [akTop, akLeft, akRight, akBottom]
DefaultItemHeight = 18
ScrollBars = ssAutoBoth
TabOrder = 1
end
object Panel2: TPanel
Left = 0
Height = 50
Top = 421
Width = 431
Align = alBottom
BevelOuter = bvNone
Caption = 'Controls to edit the shortcut...'
TabOrder = 2
end
end
end

222
src/ce_shortcutseditor.pas Normal file
View File

@ -0,0 +1,222 @@
unit ce_shortcutseditor;
{$I ce_defines.inc}
interface
uses
Classes, SysUtils, FileUtil, TreeFilterEdit, Forms, Controls, Menus,
ExtCtrls, LCLProc, ComCtrls,
ce_observer, ce_interfaces, ce_common, ce_writableComponent;
type
TShortcutItem = class(TCollectionItem)
private
fIdentifier: string;
fData: TShortcut;
published
property identifier: string read fIdentifier write fIdentifier;
property data: TShortcut read fData write fData;
public
function combination: string;
end;
TShortCutCollection = class(TWritableLfmTextComponent)
private
fCollection: TCollection;
procedure setCollection(aValue: TCollection);
function getCount: Integer;
function getShortcut(index: Integer): TShortcutItem;
published
property items: TCollection read fCollection write setCollection;
public
constructor create(AOwner: TComponent); override;
destructor destroy; override;
//
function findIdentifier(const identifier: string): boolean;
function findShortcut(aShortcut: Word): boolean;
//
property count: Integer read getCount;
property item[index: Integer]: TShortcutItem read getShortcut; default;
end;
TCEShortcutEditor = class(TFrame, ICEEditableOptions)
Panel1: TPanel;
fltItems: TTreeFilterEdit;
Panel2: TPanel;
tree: TTreeView;
private
fObservers: TCEEditableShortCutSubject;
fShortcuts: TShortCutCollection;
fBackup: TShortCutCollection;
//
function optionedWantCategory(): string;
function optionedWantEditorKind: TOptionEditorKind;
function optionedWantContainer: TPersistent;
procedure optionedEvent(anEvent: TOptionEditorEvent);
//
function findCategory(const aName: string; aData: Pointer): TTreeNode;
procedure updateFromObservers;
public
constructor create(TheOwner: TComponent); override;
destructor destroy; override;
end;
implementation
{$R *.lfm}
var
CEShortcutEditor: TCEShortcutEditor;
{$REGION TShortCutCollection ---------------------------------------------------}
function TShortcutItem.combination: string;
begin
result := ShortCutToText(fData);
end;
constructor TShortCutCollection.create(AOwner: TComponent);
begin
inherited;
fCollection := TCollection.Create(TShortcutItem);
end;
destructor TShortCutCollection.destroy;
begin
fCollection.Free;
inherited;
end;
procedure TShortCutCollection.setCollection(aValue: TCollection);
begin
fCollection.Assign(aValue);
end;
function TShortCutCollection.getCount: Integer;
begin
exit(fCollection.Count);
end;
function TShortCutCollection.getShortcut(index: Integer): TShortcutItem;
begin
exit(TShortcutItem(fCollection.Items[index]));
end;
function TShortCutCollection.findIdentifier(const identifier: string): boolean;
var
i: Integer;
begin
result := false;
for i := 0 to count-1 do
if item[i].identifier = identifier then
exit(true);
end;
function TShortCutCollection.findShortcut(aShortcut: Word): boolean;
var
i: Integer;
begin
result := false;
for i := 0 to count-1 do
if item[i].data = aShortcut then
exit(true);
end;
{$ENDREGION}
{$REGION Standard Comp/Object things -------------------------------------------}
constructor TCEShortcutEditor.create(TheOwner: TComponent);
begin
inherited;
fObservers := TCEEditableShortCutSubject.create;
fShortcuts := TShortCutCollection.create(self);
fBackup := TShortCutCollection.create(self);
//
EntitiesConnector.addObserver(self);
end;
destructor TCEShortcutEditor.destroy;
begin
fObservers.Free;
inherited;
end;
{$ENDREGION}
{$REGION ICEEditableOptions ----------------------------------------------------}
function TCEShortcutEditor.optionedWantCategory(): string;
begin
exit('Shortcuts');
end;
function TCEShortcutEditor.optionedWantEditorKind: TOptionEditorKind;
begin
exit(oekControl);
end;
function TCEShortcutEditor.optionedWantContainer: TPersistent;
begin
updateFromObservers;
exit(self);
end;
procedure TCEShortcutEditor.optionedEvent(anEvent: TOptionEditorEvent);
begin
// todo
end;
{$ENDREGION}
{$REGION shortcut editor things ------------------------------------------------}
function TCEShortcutEditor.findCategory(const aName: string; aData: Pointer): TTreeNode;
var
i: Integer;
begin
result := nil;
for i:= 0 to tree.Items.Count-1 do
if tree.Items[i].Text = aName then
if tree.Items[i].Data = aData then
exit(tree.Items[i]);
end;
procedure TCEShortcutEditor.updateFromObservers;
var
i: Integer;
obs: ICEEditableShortCut;
cat: string;
prt: TTreeNode;
sht: word;
idt: string;
itm: TShortcutItem;
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 ICEEditableShortCut;
if obs.scedWantFirst then while obs.scedWantNext(cat, idt, sht) do
begin
// root category
prt := findCategory(cat, obs);
if prt = nil then
prt := tree.Items.AddObject(nil, cat, obs);
if idt = '' then
continue;
// item as child
itm := TShortcutItem(fShortcuts.items.Add);
itm.identifier := idt;
itm.data:= sht;
tree.Items.AddChildObject(prt, idt, itm);
cat := '';
idt := '';
end;
end;
end;
{$ENDREGION}
initialization
CEShortcutEditor := TCEShortcutEditor.Create(nil);
finalization
CEShortcutEditor.Free;
end.