* Focus handling. Let element dispatch events, so it can react on an event without needing to install handler

src/base/fresnel.dom.pas

@@ -309,13 +309,15 @@ const
 
 type
   TFresnelCSSPseudoClass = (
-    fcpcHover
+    fcpcHover,
+    fcpcFocus
     );
   TFresnelCSSPseudoClasses = set of TFresnelCSSPseudoClass;
 
 const
   FresnelCSSPseudoClassNames: array[TFresnelCSSPseudoClass] of string = (
-    'hover'
+    'hover',
+    'focus'
     );
 
 Type
@@ -1103,6 +1105,7 @@ type
     procedure SetParentComponent(Value: TComponent); override;
     procedure ChildDestroying(El: TFresnelElement); virtual;
     procedure DoRender({%H-}aRenderer: IFresnelRenderer); virtual;
+    Function DoDispatchEvent(aEvent : TAbstractEvent) : Integer; virtual;
     { IFresnelRenderable }
     Procedure BeforeRender;
     Procedure AfterRender;
@@ -1116,6 +1119,14 @@ type
     function GetRoot: TFresnelElement;
     function GetPath: string; virtual;
     function AcceptChildrenAtDesignTime: boolean; virtual;
+    // Can this widget handle focus ?
+    class function HandleFocus : Boolean; virtual;
+    // Can this widget focus now ?
+    function CanFocus : Boolean; virtual;
+    // Is the widget focused ?
+    function IsFocused : Boolean;
+    // Attempt to set focus to this element. Return true if we got focus.
+    function Focus : Boolean;
     procedure DomChanged; virtual;
     property Parent: TFresnelElement read FParent write SetParent;
     property NodeCount: integer read GetNodeCount;
@@ -1225,6 +1236,7 @@ type
     // Events
     function AddEventListener(aID : TEventID; aHandler : TFresnelEventHandler) : Integer;
     function AddEventListener(Const aName: TEventName; aHandler : TFresnelEventHandler) : Integer;
+    Function DispatchEvent(aEvent : TAbstractEvent) : Integer;
     property EventDispatcher: TFresnelEventDispatcher Read FEventDispatcher;
     // Font
     property Font: IFresnelFont read GetFont write FFont;
@@ -1328,11 +1340,15 @@ type
     FScrollbarWidth: array[boolean] of TFresnelLength;
     FHeight: TFresnelLength;
     FWidth: TFresnelLength;
+    FFocusedElement : TFresnelElement;
     procedure CSSResolverLog(Sender: TObject; Entry: TCSSResolverLogEntry);
+    function GetFocusedElement: TFresnelElement;
+    procedure SetFocusedElement(const aValue: TFresnelElement);
   protected
     class var FFresnelEventsRegistered: boolean;
   protected
     FVPApplication: IFresnelVPApplication;
+    procedure Bubble(lElement: TFresnelElement; lEvt: TFresnelEvent);
     function GetDPI(IsHorizontal: boolean): TFresnelLength; override;
     function GetHeight: TFresnelLength; virtual;
     function GetScrollbarWidth(IsHorizontal: boolean): TFresnelLength; virtual;
@@ -1352,6 +1368,7 @@ type
       const AValue: TFresnelLength); virtual;
     procedure SetWidth(AValue: TFresnelLength); virtual;
     procedure StylesheetChanged; virtual;
+    function TrySetFocusControl(aControl : TFresnelElement) : Boolean;
   public type
 
       { TBubbleMouseClickEvent }
@@ -1423,6 +1440,7 @@ type
     function PageToContentPos(El: TFresnelElement; const x, y: TFresnelLength): TFresnelPoint; virtual; overload; // content of viewport to content box of El
     function PageToContentPos(El: TFresnelElement; const p: TFresnelPoint): TFresnelPoint; virtual; overload; // content of viewport to content box of El
     procedure WSMouseXY(WSData: TFresnelMouseEventInit; MouseEventId: TEventID); virtual;
+    procedure WSKey(WSData: TFresnelKeyEventInit; KeyEventId: TEventID); virtual;
     property VPApplication: IFresnelVPApplication read FVPApplication;
     property DPI[IsHorizontal: boolean]: TFresnelLength read GetDPI write SetDPI;
     property ScrollbarWidth[IsHorizontal: boolean]: TFresnelLength read GetScrollbarWidth write SetScrollbarWidth;
@@ -1436,6 +1454,7 @@ type
     property FontEngine: TFresnelFontEngine read FFontEngine write FFontEngine;
     property OnDomChanged: TNotifyEvent read FOnDomChanged write FOnDomChanged;
     property DomModified: boolean read FDomModified write FDomModified;
+    Property FocusedElement : TFresnelElement read FFocusedElement Write SetFocusedElement;
   end;
   TFLViewPort = TFresnelViewport;
 
@@ -5524,6 +5543,16 @@ begin
   DoLog(etDebug,'TFresnelViewport.CSSResolverLog ['+IntToStr(Entry.ID)+'] '+Entry.Msg+' at '+Resolver.GetElPos(Entry.PosEl));
 end;
 
+function TFresnelViewport.GetFocusedElement: TFresnelElement;
+begin
+  Result:=FFocusedElement;
+end;
+
+procedure TFresnelViewport.SetFocusedElement(const aValue: TFresnelElement);
+begin
+  TrySetFocusControl(aValue);
+end;
+
 function TFresnelViewport.GetDPI(IsHorizontal: boolean): TFresnelLength;
 begin
   Result:=FDPI[IsHorizontal];
@@ -5574,6 +5603,49 @@ begin
   DomChanged;
 end;
 
+function TFresnelViewport.TrySetFocusControl(aControl: TFresnelElement): Boolean;
+
+var
+  lOldElement : TFresnelElement;
+  lEvt : TFresnelFocusEvent;
+
+begin
+  Result:=Assigned(aControl) and (aControl.HandleFocus and aControl.CanFocus);
+  if not Result then
+    exit;
+  lEvt:=Nil;
+  try
+    if assigned(FFocusedElement) then
+      begin
+      // Blur does not bubble;
+      lEvt:=TFresnelFocusEvent.Create(FFocusedElement,evtBlur);
+      lEvt.Related:=aControl;
+      FFocusedElement.DispatchEvent(lEvt);
+      FreeAndNil(lEvt);
+      // But focusout does...
+      lEvt:=TFresnelFocusEvent.Create(FFocusedElement,evtFocusOut);
+      lEvt.Related:=aControl;
+      Bubble(FFocusedElement,lEvt);
+      end;
+    lOldElement:=FFocusedElement;
+    FFocusedElement:=aControl;
+    if assigned(FFocusedElement) then
+      begin
+      // Focus does not bubble;
+      lEvt:=TFresnelFocusEvent.Create(FFocusedElement,evtFocus);
+      lEvt.Related:=lOldElement;
+      FFocusedElement.DispatchEvent(levt);
+      FreeAndNil(lEvt);
+      // But focusin does...
+      lEvt:=TFresnelFocusEvent.Create(FFocusedElement,evtFocusIn);
+      lEvt.Related:=lOldElement;
+      Bubble(FFocusedElement,lEvt);
+      end;
+  finally
+    lEvt.Free;
+  end;
+end;
+
 procedure TFresnelViewport.FPOObservedChanged(ASender: TObject;
   Operation: TFPObservedOperation; Data: Pointer);
 begin
@@ -5934,14 +6006,15 @@ begin
     exit;
 
   NewPageXY:=WSData.PagePos;
-
+  if evtMouseDown=MouseEventID then
+    Writeln('Ah');
   NewHoverElements:=GetElementsAt(NewPageXY.X,NewPageXY.Y);
   OldHoverElements:=VPApplication.GetHoverElements;
   OldMouseDownEl:=VPApplication.GetMouseDownElement(OldPageXY);
 
   MouseEvt:=nil;
   try
-    // sent mouse leave events in stacking order top to bottom
+    // send mouse leave events in stacking order top to bottom
     for i:=0 to length(OldHoverElements)-1 do
     begin
       El:=OldHoverElements[i];
@@ -5953,7 +6026,7 @@ begin
       writeln('TFresnelViewport.WSMouseXY LEAVE ',El.GetPath);
       {$ENDIF}
       MouseEvt:=El.EventDispatcher.CreateEvent(El,evtMouseLeave) as TFresnelMouseLeaveEvent;
-      El.EventDispatcher.DispatchEvent(MouseEvt);
+      El.DispatchEvent(MouseEvt);
       FreeAndNil(MouseEvt);
 
       if El=OldMouseDownEl then
@@ -5966,9 +6039,9 @@ begin
       {$IFDEF VerboseFresnelMouse}
       writeln('TFresnelViewport.WSMouseXY LEAVE VIEWPORT');
       {$ENDIF}
-      MouseEvt:=EventDispatcher.CreateEvent(Self,evtMouseLeave) as TFresnelMouseLeaveEvent;
-      EventDispatcher.DispatchEvent(MouseEvt);
       FreeAndNil(MouseEvt);
+      MouseEvt:=EventDispatcher.CreateEvent(Self,evtMouseLeave) as TFresnelMouseLeaveEvent;
+      DispatchEvent(MouseEvt);
     end;
 
     VPApplication.SetHoverElements(NewHoverElements);
@@ -5979,9 +6052,9 @@ begin
       {$IFDEF VerboseFresnelMouse}
       writeln('TFresnelViewport.WSMouseXY ENTER VIEWPORT');
       {$ENDIF}
+      FreeAndNil(MouseEvt);
       MouseEvt:=EventDispatcher.CreateEvent(Self,evtMouseEnter) as TFresnelMouseEnterEvent;
       EventDispatcher.DispatchEvent(MouseEvt);
-      FreeAndNil(MouseEvt);
     end;
 
     // sent mouse enter events in stacking order bottom to top
@@ -5995,9 +6068,9 @@ begin
       {$IFDEF VerboseFresnelMouse}
       writeln('TFresnelViewport.WSMouseXY ENTER ',El.GetPath);
       {$ENDIF}
-      MouseEvt:=El.EventDispatcher.CreateEvent(El,evtMouseEnter) as TFresnelMouseEnterEvent;
-      El.EventDispatcher.DispatchEvent(MouseEvt);
       FreeAndNil(MouseEvt);
+      MouseEvt:=El.EventDispatcher.CreateEvent(El,evtMouseEnter) as TFresnelMouseEnterEvent;
+      El.DispatchEvent(MouseEvt);
     end;
 
   finally
@@ -6042,7 +6115,7 @@ begin
         {$IFDEF VerboseFresnelMouse}
         writeln('TFresnelViewport.WSMouseXY ',MouseEventId,' ',BubbleEl.GetPath,' ',FloatToCSSStr(MouseEvt.X),',',FloatToCSSStr(MouseEvt.Y));
         {$ENDIF}
-        BubbleEl.EventDispatcher.DispatchEvent(MouseEvt);
+        BubbleEl.DispatchEvent(MouseEvt);
         inc(i);
         if (MouseEvt.PropagationStopped) or (i>=length(NewHoverElements)) then
           break;
@@ -6059,23 +6132,20 @@ begin
 
       FreeAndNil(MouseEvt);
 
+
       if (MouseEventId=evtMouseUp) and (VPApplication.GetMouseDownElement(OldPageXY)=El) then
       begin
         // dispatch click event up the element hierarchy
         ClickEvt:=El.EventDispatcher.CreateEvent(El,evtClick) as TFresnelMouseClickEvent;
-
-        BubbleEl:=El;
-        repeat
-          {$IFDEF VerboseFresnelMouse}
-          writeln('TFresnelViewport.WSMouseXY CLICK ',BubbleEl.GetPath,' ',FloatToCSSStr(ClickEvt.X),',',FloatToCSSStr(ClickEvt.Y));
-          {$ENDIF}
-          BubbleEl.EventDispatcher.DispatchEvent(ClickEvt);
-          if ClickEvt.PropagationStopped then break;
-          BubbleEl:=BubbleEl.Parent;
-        until BubbleEl=nil;
-
+        Bubble(El,ClickEvt);
         VPApplication.SetMouseDownElement(nil,NewPageXY);
       end;
+
+      // Focus gets set on mouse down. TrySetFocusControl will test whether the element actually can get focus.
+      // Todo: Test what if a non-focus handling element is positioned over one which does handle focus ?
+      // -> go over hover list ?
+      if (MouseEventId=evtMouseDown) and Assigned(El) then
+        TrySetFocusControl(El);
     finally
       MouseEvt.Free;
       ClickEvt.Free;
@@ -6083,6 +6153,39 @@ begin
   end;
 end;
 
+procedure TFresnelViewport.Bubble(lElement : TFresnelElement; lEvt : TFresnelEvent);
+
+begin
+  While lElement<>Nil do
+    begin
+    lEvt.Sender:=lElement;
+    lElement.DispatchEvent(lEvt);
+    if lEvt.PropagationStopped then
+      lElement:=Nil
+    else
+      lElement:=lElement.Parent;
+    end;
+end;
+
+procedure TFresnelViewport.WSKey(WSData: TFresnelKeyEventInit; KeyEventId: TEventID);
+
+var
+  lFocus : TFresnelElement;
+  lEvtClass : TAbstractEventClass;
+  lKeyEvtClass : TFresnelKeyEventClass absolute lEvtClass;
+  lEvt : TFresnelKeyEvent;
+
+begin
+  lFocus:=FFocusedElement;
+  if not Assigned(lFocus) then
+    lFocus:=Self;
+  lEvtClass:=EventDispatcher.Registry.FindEventClass(KeyEventID);
+  if not lEvtClass.InheritsFrom(TFresnelKeyEvent) then
+     Raise EFresnel.CreateFmt('%s is not a descendent of class TFresnelKeyEvent',[lEvtClass.ClassName]);
+  lEvt:=lKeyEvtClass.Create(WSData);
+  Bubble(lFocus,lEvt);
+end;
+
 constructor TFresnelViewport.Create(AOwner: TComponent);
 
   Procedure R(aClass: TFresnelEventClass);
@@ -6164,6 +6267,7 @@ begin
   Result:=false;
   case Pseudo of
     fcpcHover: Result:=fesHover in FStates;
+    fcpcFocus: Result:=IsFocused;
   end;
 end;
 
@@ -6179,6 +6283,12 @@ begin
         else
           Exclude(FStates,fesHover);
       end;
+    fcpcFocus:
+      begin
+        if IsFocused then exit;
+        if aValue then
+          Focus;
+      end;
   end;
   DomChanged;
 end;
@@ -6214,7 +6324,7 @@ function TFresnelElement.GetFocusEventHandler(AIndex: Integer): TFresnelFocusEve
 begin
   Result:=nil;
   if AIndex in evtAllMouse then
-    Result:=TFresnelFOcusEventHandler(GetEventHandler(AIndex));
+    Result:=TFresnelFocusEventHandler(GetEventHandler(AIndex));
 end;
 
 function TFresnelElement.GetMouseEventHandler(AIndex: Integer
@@ -7525,6 +7635,11 @@ begin
    Result:=EventDispatcher.RegisterHandler(aHandler,aName).ID;
 end;
 
+function TFresnelElement.DispatchEvent(aEvent: TAbstractEvent): Integer;
+begin
+  Result:=DoDispatchEvent(aEvent);
+end;
+
 function TFresnelElement.GetFont: IFresnelFont;
 
   function GetViewportFontSize: TFresnelLength;
@@ -7798,6 +7913,11 @@ begin
   //
 end;
 
+function TFresnelElement.DoDispatchEvent(aEvent: TAbstractEvent): Integer;
+begin
+  Result:=EventDispatcher.DispatchEvent(aEvent);
+end;
+
 procedure TFresnelElement.BeforeRender;
 begin
   FRenderedBorderBox:=FUsedBorderBox;
@@ -7904,6 +8024,35 @@ begin
   Result:=true;
 end;
 
+class function TFresnelElement.HandleFocus: Boolean;
+begin
+  Result:=False;
+end;
+
+function TFresnelElement.CanFocus: Boolean;
+begin
+  Result:=False;
+end;
+
+function TFresnelElement.IsFocused: Boolean;
+var
+  VP : TFresnelViewport;
+begin
+  VP:=Viewport;
+  Result:=Assigned(VP) and (VP.FocusedElement=Self);
+end;
+
+function TFresnelElement.Focus: Boolean;
+var
+  VP : TFresnelViewport;
+begin
+  VP:=Viewport;
+  Result:=Assigned(VP);
+  if not Result then
+    exit;
+  Result:=VP.TrySetFocusControl(Self);
+end;
+
 procedure TFresnelElement.FPOObservedChanged(ASender: TObject;
   Operation: TFPObservedOperation; Data: Pointer);
 begin