Merge branch 'a12_2_a13'

src/ce_interfaces.pas

@@ -98,7 +98,7 @@ type
 
 
   (**
-   * An implementer can add a mai nmenu entry.
+   * An implementer can add a main menu entry.
    *)
   ICEMainMenuProvider = interface
   ['ICEMainMenuProvider']
@@ -108,7 +108,7 @@ type
     procedure menuUpdate(item: TMenuItem);
   end;
   (**
-   * An implementer agregates its observers menus.
+   * An implementer collects and updates its observers menus.
    *)
   TCEMainMenuSubject = class(TCECustomSubject)
   protected
@@ -117,6 +117,31 @@ type
 
 
 
+  (**
+   * An implementer declares some actions which have their own main menu entry and
+   * whose shortcuts are automatically handled
+   *)
+  ICEActionProvider = interface
+  ['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 = class(TCECustomSubject)
+  protected
+    function acceptObserver(aObject: TObject): boolean; override;
+  end;
+
+
+
   (**
    * An implementer can expose some customizable shortcuts to be edited in a dedicated widget.
    *)
@@ -128,7 +153,6 @@ type
     function scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean;
     // a TCEEditableShortCutSubject sends the possibly modified shortcut
     procedure scedSendItem(const category, identifier: string; aShortcut: TShortcut);
-
   end;
   (**
    * An implementer manages its observers shortcuts.
@@ -139,6 +163,7 @@ type
   end;
 
 
+
   // the option editor uses this value as a hint to cast and display an option container.
   TOptionEditorKind = (oekGeneric, oekForm, oekControl);
   // event generated by the option editor and passed to an ICEEditableOptions.
@@ -400,6 +425,11 @@ function TCEEditableOptionsSubject.acceptObserver(aObject: TObject): boolean;
 begin
   exit(aObject is ICEEditableOptions);
 end;
+
+function TCEActionProviderSubject.acceptObserver(aObject: TObject): boolean;
+begin
+  exit(aObject is ICEActionProvider);
+end;
 {$ENDREGION}
 
 {$REGION ICESingleService getters ----------------------------------------------}

src/ce_main.pas

@@ -178,6 +178,7 @@ type
   private
 
     fDoc: TCESynMemo;
+    fActionHandler: TCEActionProviderSubject;
     fMultidoc: ICEMultiDocHandler;
     fScCollectCount: Integer;
     fUpdateCount: NativeInt;
@@ -209,6 +210,10 @@ type
     fMainMenuSubj: TCEMainMenuSubject;
     procedure updateMainMenuProviders;
 
+    // action provider handling;
+    procedure clearActProviderEntries;
+    procedure collectedActProviderEntries;
+
     // ICEMultiDocObserver
     procedure docNew(aDoc: TCESynMemo);
     procedure docClosing(aDoc: TCESynMemo);
@@ -300,7 +305,8 @@ uses
 constructor TCEMainForm.create(aOwner: TComponent);
 begin
   inherited create(aOwner);
-  fMainMenuSubj:= TCEMainMenuSubject.create;
+  fMainMenuSubj := TCEMainMenuSubject.create;
+  fActionHandler := TCEActionProviderSubject.create;
   //
   EntitiesConnector.addObserver(self);
   //
@@ -648,6 +654,7 @@ begin
   FreeRunnableProc;
   //
   fMainMenuSubj.Free;
+  fActionHandler.Free;
   EntitiesConnector.removeObserver(self);
   inherited;
 end;
@@ -696,6 +703,11 @@ begin
   {$ENDIF}
   if fUpdateCount > 0 then exit;
   Inc(fUpdateCount);
+
+
+  clearActProviderEntries;
+  collectedActProviderEntries;
+
   try
     HasEd := fDoc <> nil;
     if hasEd then
@@ -905,7 +917,7 @@ begin
 end;
 {$ENDREGION}
 
-{$REGION ICEEditableShortCut}
+{$REGION ICEEditableShortCut ---------------------------------------------------}
 function TCEMainForm.scedWantFirst: boolean;
 begin
   fScCollectCount := 0;
@@ -931,6 +943,60 @@ begin
 end;
 {$ENDREGION}
 
+{$REGION TCEActionProviderHandler ----------------------------------------------}
+procedure TCEMainForm.clearActProviderEntries;
+var
+  prov: ICEActionProvider;
+  act: TContainedAction;
+  i, j: 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 then continue;
+      if act.Tag <> PtrInt(prov) then continue;
+      //
+      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;
+end;
+{$ENDREGION}
+
 {$REGION file ------------------------------------------------------------------}
 procedure TCEMainForm.actFileHtmlExportExecute(Sender: TObject);
 var
@@ -1403,13 +1469,18 @@ begin
   if widg = nil then exit;
   //
   if widg.isDockable then
-    win := DockMaster.GetAnchorSite(widg)
+  begin
-  else
+    win := DockMaster.GetAnchorSite(widg);
-    win := widg;
+    win.Show;
-  //
+    win.BringToFront;
-  if win = nil then exit;
+  end
-  win.Show;
+  else begin
-  win.BringToFront;
+    if widg.isModal then widg.ShowModal else
+    begin
+      widg.Show;
+      widg.BringToFront;
+    end;
+  end;
 end;
 
 procedure TCEMainForm.layoutLoadFromFile(const aFilename: string);

src/ce_optionseditor.lfm

@@ -7,7 +7,7 @@ inherited CEOptionEditorWidget: TCEOptionEditorWidget
   Caption = 'Options editor'
   ClientHeight = 493
   ClientWidth = 559
-  FormStyle = fsStayOnTop
+  FormStyle = fsSystemStayOnTop
   inherited Back: TPanel
     Height = 493
     Width = 559

src/ce_optionseditor.pas

@@ -57,6 +57,7 @@ var
 begin
   inherited;
   fDockable := false;
+  fModal:= true;
   fEdOptsSubj := TCEEditableOptionsSubject.create;
   //
   png := TPortableNetworkGraphic.Create;

src/ce_shortcutseditor.pas

@@ -15,6 +15,8 @@ type
   private
     fIdentifier: string;
     fData: TShortcut;
+    fDeclarator: ICEEditableShortCut;
+    property declarator: ICEEditableShortCut read fDeclarator write fDeclarator;
   published
     property identifier: string read fIdentifier write fIdentifier;
     property data: TShortcut read fData write fData;
@@ -220,13 +222,23 @@ begin
 end;
 
 procedure TCEShortcutEditor.LabeledEdit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+var
+  sh: TShortCut;
 begin
   if tree.Selected = nil then exit;
   if tree.Selected.Level = 0 then exit;
   if tree.Selected.Data = nil then exit;
   //
-  if Key = VK_RETURN then shortcutCatcher.Enabled := false
+  if Key = VK_RETURN then
-  else TShortcutItem(tree.Selected.Data).data := Shortcut(Key, Shift);
+    shortcutCatcher.Enabled := false
+  else
+  begin
+    sh := Shortcut(Key, Shift);
+    TShortcutItem(tree.Selected.Data).data := sh;
+    TShortcutItem(tree.Selected.Data).declarator.scedSendItem(
+      tree.Selected.Parent.Text,
+      tree.Selected.Text, sh );
+  end;
   //
   updateEditCtrls;
 end;
@@ -281,6 +293,7 @@ begin
   itm := TShortcutItem(fShortcuts.items.Add);
   itm.identifier := idt;
   itm.data:= sht;
+  itm.declarator := obs;
   tree.Items.AddChildObject(prt, idt, itm);
   cat := '';
   idt := '';

src/ce_tools.pas

@@ -204,15 +204,20 @@ procedure TCETools.menuDeclare(item: TMenuItem);
 var
   i: Integer;
   itm: TMenuItem;
+  colitm: TCEToolItem;
 begin
   if tools.Count = 0 then exit;
   //
   item.Caption := 'Custom tools';
   item.Clear;
-  for i := 0 to tools.Count-1 do begin
+  for i := 0 to tools.Count-1 do
+  begin
+    colitm := tool[i];
+    //
     itm := TMenuItem.Create(item);
-    itm.Caption := tool[i].toolAlias;
+    itm.ShortCut:= colitm.shortcut;
-    itm.tag := ptrInt(tool[i]);
+    itm.Caption := colitm.toolAlias;
+    itm.tag := ptrInt(colitm);
     itm.onClick := @executeToolFromMenu;
     item.add(itm);
   end;
@@ -221,16 +226,23 @@ end;
 procedure TCETools.menuUpdate(item: TMenuItem);
 var
   i: Integer;
+  colitm: TCEToolItem;
+  mnuitm: TMenuItem;
 begin
   if item = nil then exit;
   if item.Count <> tools.Count then
     menuDeclare(item)
   else for i:= 0 to tools.Count-1 do
   begin
-    if ptrInt(tool[i]) <> item.Items[i].Tag then
+    colitm := tool[i];
-      item.Items[i].Tag := ptrInt(tool[i]);
+    mnuitm := item.Items[i];
-    if item.Items[i].Caption <> tool[i].toolAlias then
+    //
-      item.Items[i].Caption := tool[i].toolAlias;
+    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;
 {$ENDREGION}
@@ -253,8 +265,16 @@ begin
 end;
 
 procedure TCETools.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;
 {$ENDREGION}
 

src/ce_widget.pas

@@ -36,6 +36,7 @@ type
     procedure optset_UpdaterDelay(aReader: TReader);
   protected
     fDockable: boolean;
+    fModal: boolean;
     fID: string;
     // a descendant overrides to implementi a periodic update.
     procedure UpdateByLoop; virtual;
@@ -51,6 +52,8 @@ type
     procedure sesoptBeforeSave; virtual;
     procedure sesoptDeclareProperties(aFiler: TFiler); virtual;
     procedure sesoptAfterLoad; virtual;
+    //
+    function getIfModal: boolean;
   published
     property updaterByLoopInterval: Integer read fLoopInter write setLoopInt;
     property updaterByDelayDuration: Integer read fDelayDur write setDelayDur;
@@ -77,6 +80,8 @@ type
     property updating: boolean read fUpdating;
     // true by default, allow a widget to be docked.
     property isDockable: boolean read fDockable;
+    // not if isDockable, otherwise a the widget is shown as modal form.
+    property isModal: boolean read getIfModal;
   end;
 
   (**
@@ -138,6 +143,13 @@ begin
   EntitiesConnector.removeObserver(self);
   inherited;
 end;
+
+function TCEWidget.getIfModal: boolean;
+begin
+  if isDockable then result := false
+  else result := fModal;
+end;
+
 {$ENDREGION}
 
 {$REGION ICESessionOptionsObserver ---------------------------------------------}