Now connects setting the accessible fields to LCLIntf via TControl.SetAccessibleFields and starts the carbon accessibility fields implementation

git-svn-id: trunk@34689 -

lcl/controls.pp

@@ -1313,6 +1313,8 @@ type
     function ReplaceDockedControl(Control: TControl; NewDockSite: TWinControl;
                            DropControl: TControl; ControlSide: TAlign): Boolean;
     function Dragging: Boolean;
+    // accessibility
+    procedure SetAccesibilityFields(const ADescription, AName: string; const ARole: TLazAccessibilityRole);
   public
     // size
     procedure AdjustSize; virtual;// smart calling DoAutoSize

lcl/include/control.inc

@@ -1340,19 +1340,19 @@ end;
 procedure TControl.SetAccessibleDescription(AValue: TCaption);
 begin
   if FAccessibleDescription=AValue then Exit;
-  FAccessibleDescription:=AValue;
+  SetAccesibilityFields(AValue, FAccessibleName, FAccessibleRole);
 end;
 
 procedure TControl.SetAccessibleName(AValue: TCaption);
 begin
   if FAccessibleName=AValue then Exit;
-  FAccessibleName:=AValue;
+  SetAccesibilityFields(FAccessibleDescription, AValue, FAccessibleRole);
 end;
 
 procedure TControl.SetAccessibleRole(AValue: TLazAccessibilityRole);
 begin
   if FAccessibleRole=AValue then Exit;
-  FAccessibleRole:=AValue;
+  SetAccesibilityFields(FAccessibleDescription, FAccessibleName, AValue);
 end;
 
 {------------------------------------------------------------------------------
@@ -1404,6 +1404,15 @@ begin
   Result := DragManager.Dragging(Self);
 end;
 
+// accessibility
+procedure TControl.SetAccesibilityFields(const ADescription, AName: string; const ARole: TLazAccessibilityRole);
+begin
+  FAccessibleDescription := ADescription;
+  FAccessibleName := AName;
+  FAccessibleRole := ARole;
+  TWSControl.LazAccessibility_SetFields(Self, ADescription, AName, ARole);
+end;
+
 {------------------------------------------------------------------------------
        TControl GetBoundsRect
 ------------------------------------------------------------------------------}

lcl/include/treeview.inc

@@ -3019,6 +3019,7 @@ begin
   FTreeLineColor := clWindowFrame;
   FTreeLinePenStyle := psPattern;
   FExpandSignColor := clWindowFrame;
+  SetAccesibilityFields('A tree of items', 'T Tree View', larTreeView);
 end;
 
 destructor TCustomTreeView.Destroy;

lcl/interfaces/carbon/carbonprivate.pp

@@ -720,6 +720,22 @@ begin
       RegisterEventHandler(@CarbonScrollable_ScrollTo),
       1, @TmpSpec, Pointer(Self), nil);
   end;
+
+  // Accessibility
+  TmpSpec := MakeEventSpec(kEventClassAccessibility, kEventAccessibleGetNamedAttribute);
+  InstallControlEventHandler(Content,
+    RegisterEventHandler(@CarbonControl_AccessibleGetNamedAttribute),
+    1, @TmpSpec, Pointer(Self), nil);
+{   kEventAccessibleGetChildAtPoint = 1,
+   kEventAccessibleGetFocusedChild = 2,
+   kEventAccessibleGetAllAttributeNames = 21,
+   kEventAccessibleGetAllParameterizedAttributeNames = 25,
+   kEventAccessibleGetNamedAttribute = 22,
+   kEventAccessibleSetNamedAttribute = 23,
+   kEventAccessibleIsNamedAttributeSettable = 24,
+   kEventAccessibleGetAllActionNames = 41,
+   kEventAccessiblePerformNamedAction = 42,
+   kEventAccessibleGetNamedActionDescription = 44}
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/carbon/carbonprivatecommon.inc

@@ -530,4 +530,3 @@ begin
   end;
 end;
 
-

lcl/interfaces/carbon/carbonprivatecontrol.inc

@@ -125,6 +125,98 @@ begin
   Result := CallNextEventHandler(ANextHandler, AEvent);
 end;
 
+{------------------------------------------------------------------------------
+  Name: CarbonControl_AccessibleGetNamedAttribute
+  Accessibility
+
+  The named attributes are:
+
+  AXRole
+  AXRoleDescription
+  AXDescription
+  AXHelp
+  AXParent
+  AXChildren
+  AXWindow
+  AXTopLevelUIElement
+  AXEnabled
+  AXSize
+  AXPosition
+ ------------------------------------------------------------------------------}
+function CarbonControl_AccessibleGetNamedAttribute(ANextHandler: EventHandlerCallRef;
+  AEvent: EventRef;
+  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
+var
+  lAXRole, lInputStr, lOutputStr: CFStringRef;
+  lInputPasStr: string;
+  lLazControl: TControl;
+  lLazAXRole: TLazAccessibilityRole;
+  Command: HICommandExtended;
+const SName = 'CarbonControl_AccessibleGetNamedAttribute';
+begin
+  {$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
+    DebugLn('CarbonControl_AccessibleGetNamedAttribute LCLObject=', DbgSName(AWidget.LCLObject));
+  {$ENDIF}
+
+  Result := CallNextEventHandler(ANextHandler, AEvent); // Must be called at the event handling start
+
+  lLazControl := TControl((AWidget as TCarbonControl).LCLObject);
+
+  if not OSError(
+    GetEventParameter(AEvent, kEventParamAccessibleAttributeName,
+      typeCFStringRef, nil, SizeOf(CFStringRef), nil, @lInputStr),
+    SName, 'GetEventParameter') then
+  begin
+    lInputPasStr := CFStringToStr(lInputStr);
+
+    {$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
+      DebugLn('CarbonControl_AccessibleGetNamedAttribute kEventParamAccessibleAttributeName=' + lInputPasStr);
+    {$ENDIF}
+
+    lLazAXRole := lLazControl.AccessibleRole;
+
+    if lInputPasStr = 'AXRole' then
+    begin
+      case lLazAXRole of
+        // kAXApplicationRole
+        // kAXBrowserRole
+        larTreeView: lAXRole := CFSTR('AXBrowser'); // alternatively
+        // kAXButtonRole
+        // kAXCheckBoxRole
+        // kAXColumnRole
+        // kAXDrawerRole
+        // kAXGrowAreaRole
+        // kAXImageRole
+        // kAXMenuButtonRole
+        // kAXOutlineRole
+        // kAXPopUpButtonRole
+        // kAXRadioButtonRole
+        // kAXRowRole
+        // kAXSheetRole
+        // kAXSystemWideRole
+        // kAXTabGroupRole
+        // kAXTableRole
+        // kAXWindowRole
+        larWindow: lAXRole := CFSTR('AXWindow'); // alternatively
+      // kAXUnknownRole
+      else
+        lAXRole := CFSTR('AXUnknown');
+      end;
+
+      //if OSError(
+      SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef,
+        SizeOf(CFStringRef), @lAXRole);//, SName, SSetEvent, SControlAction) then Exit;
+    end
+    else if lInputPasStr = 'AXRoleDescription' then
+    begin
+      CreateCFString(lLazControl.AccessibleDescription, lOutputStr);
+      SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef,
+        SizeOf(CFStringRef), @lOutputStr);
+      FreeCFString(lOutputStr);
+    end;
+  end;
+end;
+
 { TCarbonToolBar }
 
 procedure TCarbonToolBar.CreateWidget(const AParams: TCreateParams);

lcl/lcltype.pp

@@ -142,16 +142,18 @@ type
     larCheckBox, // An object that can be checked or unchecked, or sometimes in an intermediary state
     larClock, // A clock displaying time.
     larComboBox, // A list of choices that the user can select from.
-    larEditableText, //	Editable text
+    larGrid, // A grid control which displays cells
     larIgnore, // Something to be ignored. For example a blank space between other objects.
     larImage, // A graphic or picture or an icon.
-    larGrip, // A grip that the user can drag to change the size of widgets.
     larHotkeyField, // A hotkey field that allows the user to enter a key sequence.
     larHotLink, // A link to something else.
     larLabel, // A text label as usually placed near other widgets.
-    larList, // A list of items, from which the user can select one or more items.
+    larListView, // A list of items, from which the user can select one or more items.
     larListItem, // An item in a list of items.
-    larTree, // A list of items in a tree structure.
+    larResizeGrip, // A grip that the user can drag to change the size of widgets.
+    larTextEditorMultiline, // A multi-line text editor (for example: TMemo, SynEdit)
+    larTextEditorSingleline, // A single-line text editor (for example: TEdit)
+    larTreeView, // A list of items in a tree structure.
     larTreeItem, // An item in a tree structure.
     larWindow // A top level window.
   );