Improves the accessibility support in LCL-Carbon. Starts implementing support for more accessibility support and starts adding accessibility roles for TCustomForm

git-svn-id: trunk@34695 -

lcl/include/customform.inc

@@ -1938,6 +1938,9 @@ begin
   if ParentBiDiMode then
     BiDiMode := Application.BidiMode;
 
+  // Accessibility
+  SetAccesibilityFields('A window', 'T Form', larWindow);
+
   // the EndFormUpdate is done in AfterConstruction
 end;
 

lcl/interfaces/carbon/carbonprivate.pp

@@ -710,6 +710,7 @@ end;
 procedure TCarbonCustomControl.RegisterEvents;
 var
   TmpSpec: EventTypeSpec;
+  AccessibilitySpec: array [0..2] of EventTypeSpec;
 begin
   inherited RegisterEvents;
   
@@ -722,20 +723,23 @@ begin
   end;
 
   // Accessibility
-  TmpSpec := MakeEventSpec(kEventClassAccessibility, kEventAccessibleGetNamedAttribute);
+  AccessibilitySpec[0].eventClass := kEventClassAccessibility;
+  AccessibilitySpec[0].eventKind := kEventAccessibleGetChildAtPoint;
+  AccessibilitySpec[1].eventClass := kEventClassAccessibility;
+  AccessibilitySpec[1].eventKind := kEventAccessibleGetFocusedChild;
+  // kEventAccessibleGetAllAttributeNames
+  // kEventAccessibleGetAllParameterizedAttributeNames
+  AccessibilitySpec[2].eventClass := kEventClassAccessibility;
+  AccessibilitySpec[2].eventKind := kEventAccessibleGetNamedAttribute;
+  // kEventAccessibleSetNamedAttribute
+  // kEventAccessibleIsNamedAttributeSettable
+  // kEventAccessibleGetAllActionNames
+  // kEventAccessiblePerformNamedAction
+  // kEventAccessibleGetNamedActionDescription
+
   InstallControlEventHandler(Content,
-    RegisterEventHandler(@CarbonControl_AccessibleGetNamedAttribute),
+    RegisterEventHandler(@CarbonControl_Accessibility),
-    1, @TmpSpec, Pointer(Self), nil);
+    3, @AccessibilitySpec[0], 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/carbonprivatecontrol.inc

@@ -126,10 +126,23 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-  Name: CarbonControl_AccessibleGetNamedAttribute
+  Name: CarbonControl_Accessibility
   Accessibility
 
-  The named attributes are:
+  The events for this handler are:
+
+  kEventAccessibleGetChildAtPoint
+  kEventAccessibleGetFocusedChild
+  kEventAccessibleGetAllAttributeNames
+  kEventAccessibleGetAllParameterizedAttributeNames
+  kEventAccessibleGetNamedAttribute
+  kEventAccessibleSetNamedAttribute
+  kEventAccessibleIsNamedAttributeSettable
+  kEventAccessibleGetAllActionNames
+  kEventAccessiblePerformNamedAction
+  kEventAccessibleGetNamedActionDescription
+
+  For kEventAccessibleGetNamedAttribute the named attributes are:
 
   AXRole
   AXRoleDescription
@@ -143,78 +156,114 @@ end;
   AXSize
   AXPosition
  ------------------------------------------------------------------------------}
-function CarbonControl_AccessibleGetNamedAttribute(ANextHandler: EventHandlerCallRef;
+function CarbonControl_Accessibility(ANextHandler: EventHandlerCallRef;
   AEvent: EventRef;
   AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
 var
   lAXRole, lInputStr, lOutputStr: CFStringRef;
   lInputPasStr: string;
+  lInputMutableArray: CFMutableArrayRef;
+  lOutputBool: CFBooleanRef;
   lLazControl: TControl;
   lLazAXRole: TLazAccessibilityRole;
   Command: HICommandExtended;
-const SName = 'CarbonControl_AccessibleGetNamedAttribute';
+  EventKind: UInt32;
+const SName = 'CarbonControl_Accessibility';
 begin
   {$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
-    DebugLn('CarbonControl_AccessibleGetNamedAttribute LCLObject=', DbgSName(AWidget.LCLObject));
+    DebugLn('CarbonControl_Accessibility LCLObject=', DbgSName(AWidget.LCLObject));
   {$ENDIF}
 
   Result := CallNextEventHandler(ANextHandler, AEvent); // Must be called at the event handling start
 
   lLazControl := TControl((AWidget as TCarbonControl).LCLObject);
+  lLazAXRole := lLazControl.AccessibleRole;
 
-  if not OSError(
+  EventKind := GetEventKind(AEvent);
-    GetEventParameter(AEvent, kEventParamAccessibleAttributeName,
+  case EventKind of
-      typeCFStringRef, nil, SizeOf(CFStringRef), nil, @lInputStr),
+    kEventAccessibleGetAllAttributeNames:
-    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
+      {$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
-        // kAXApplicationRole
+        DebugLn('CarbonControl_Accessibility kEventAccessibleGetAllAttributeNames');
-        // kAXBrowserRole
+      {$ENDIF}
-        larTreeView: lAXRole := CFSTR('AXBrowser'); // alternatively
+
-        // kAXButtonRole
+      if OSError(
-        // kAXCheckBoxRole
+        GetEventParameter(AEvent, kEventParamAccessibleAttributeNames,
-        // kAXColumnRole
+          typeCFMutableArrayRef, nil, SizeOf(CFMutableArrayRef), nil, @lInputMutableArray),
-        // kAXDrawerRole
+        SName, 'GetEventParameter') then Exit;
-        // kAXGrowAreaRole
+
-        // kAXImageRole
+      {$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
-        // kAXMenuButtonRole
+        DebugLn('CarbonControl_Accessibility kEventAccessibleGetAllAttributeNames After GetEventParameter');
-        // kAXOutlineRole
+      {$ENDIF}
-        // kAXPopUpButtonRole
+
-        // kAXRadioButtonRole
+      // AXFocused interrests all classes
-        // kAXRowRole
+      lOutputStr := CFSTR('AXFocused');
-        // kAXSheetRole
+      CFArrayAppendValue(lInputMutableArray, lOutputStr);
-        // kAXSystemWideRole
+    end; // kEventAccessibleGetAllAttributeNames
-        // kAXTabGroupRole
+    kEventAccessibleGetNamedAttribute:
-        // kAXTableRole
+    begin
-        // kAXWindowRole
+      if OSError(
-        larWindow: lAXRole := CFSTR('AXWindow'); // alternatively
+        GetEventParameter(AEvent, kEventParamAccessibleAttributeName,
-      // kAXUnknownRole
+          typeCFStringRef, nil, SizeOf(CFStringRef), nil, @lInputStr),
-      else
+        SName, 'GetEventParameter') then Exit;
-        lAXRole := CFSTR('AXUnknown');
+
+      lInputPasStr := CFStringToStr(lInputStr);
+
+      {$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
+        DebugLn('CarbonControl_Accessibility kEventAccessibleGetNamedAttribute kEventParamAccessibleAttributeName=' + lInputPasStr);
+      {$ENDIF}
+
+      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
+      else if lInputPasStr = 'AXFocused' then
+      begin
+        if not (lLazControl is TWinControl) then Exit;
+
+        if TWinControl(lLazControl).Focused then lOutputBool := kCFBooleanTrue
+        else lOutputBool := kCFBooleanFalse;
+
+        SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFBooleanRef,
+          SizeOf(CFBooleanRef), @lOutputBool);
       end;
-
+    end; // kEventAccessibleGetNamedAttribute
-      //if OSError(
+  end; // case EventKind of
-      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 }