Implements AccessibleValue for TTreeView items even when reading from the lfm. Improves the Carbon accessibility code for lists

git-svn-id: trunk@34830 -

lcl/controls.pp

@@ -959,7 +959,7 @@ type
     property AccessibleDescription: TCaption read FAccessibleDescription write SetAccessibleDescription;
     property AccessibleValue: TCaption read FAccessibleValue write SetAccessibleValue;
     property AccessibleRole: TLazAccessibilityRole read FAccessibleRole write SetAccessibleRole;
-    property Handle: PtrInt read GetHandle;
+    property Handle: PtrInt read GetHandle write FHandle;
   end;
 
 {* Note on TControl.Caption

lcl/include/treeview.inc

@@ -29,8 +29,6 @@
 
 { $DEFINE TREEVIEW_DEBUG}
 
-{ TTreeViewAccessibleObject }
-
 const
   TTreeNodeWithPointerStreamVersion : word = 1;
   TTreeNodeStreamVersion : word = 2;
@@ -398,6 +396,8 @@ begin
 end;
 
 procedure TTreeNode.SetText(const S: string);
+var
+  lSelfAX: TLazAccessibleObject;
 begin
   if S=FText then exit;
   FText := S;
@@ -409,6 +409,10 @@ begin
     else TreeView.AlphaSort;
   end;
   Update;
+  // Update accessibility information
+  lSelfAX := TreeView.GetAccessibleObject.GetChildAccessibleObjectWithDataObject(Self);
+  if lSelfAX <> nil then
+    lSelfAX.AccessibleValue := S;
 end;
 
 procedure TTreeNode.SetData(AValue: Pointer);
@@ -1740,6 +1744,7 @@ var
   OldInfo: TOldTreeNodeInfo;
   Info: TTreeNodeInfo;
   Node: TTreeNode;
+  lSelfAX: TLazAccessibleObject;
 begin
   if Owner<>nil then Owner.ClearCache;
   if StreamVersion=TTreeNodeWithPointerStreamVersion then
@@ -1768,7 +1773,16 @@ begin
     SetLength(FText,Info.TextLen);
   end;
   if FText<>'' then
+  begin
     Stream.Read(FText[1],length(FText));
+    // Update accessibility information
+    if TreeView<>nil then
+    begin
+     lSelfAX := TreeView.GetAccessibleObject.GetChildAccessibleObjectWithDataObject(Self);
+     if lSelfAX <> nil then
+       lSelfAX.AccessibleValue := FText;
+    end;
+  end;
   if Owner<>nil then begin
     for I := 0 to ItemCount - 1 do begin
       Node:=Owner.AddChild(Self, '');
@@ -2228,7 +2242,8 @@ begin
     if ok and (Owner<>nil) then
     begin
       lAccessibleObject := FOwner.GetAccessibleObject().AddChildAccessibleObject();
-      lAccessibleObject.AccessibleDescription := S;
+      lAccessibleObject.AccessibleDescription := 'Item';
+      lAccessibleObject.AccessibleValue := S;
       lAccessibleObject.AccessibleRole := larTreeItem;
       lAccessibleObject.DataObject := Result;
     end;

lcl/interfaces/carbon/carbondefines.inc

@@ -24,6 +24,10 @@
   {$define CarbonUseCocoa}
 {$endif}
 
+{$ifndef VER2_2}{$ifndef VER2_4}{$ifndef CarbonDontUseCocoa}
+  {$define CarbonUseCocoaAll}
+{$endif}{$endif}{$endif}
+
 // Show debug info when tracing:
 
 {off $define DebugBitmaps}

lcl/interfaces/carbon/carbonprivate.pp

@@ -33,6 +33,9 @@ uses
   Types, Classes, SysUtils, Math, Contnrs,
   // carbon bindings
   MacOSAll,
+  {$ifdef CarbonUseCocoaAll}
+  CocoaAll,
+  {$endif}
  // widgetset
   WSControls, WSLCLClasses, WSProc,
  // LCL Carbon

lcl/interfaces/carbon/carbonprivatecontrol.inc

@@ -165,12 +165,17 @@ end;
 
   http://developer.apple.com/library/mac/#documentation/Accessibility/Reference/AccessibilityCarbonRef/Reference/reference.html
 
+  Documentation explaining in details which attributes are required for each Role:
+
+  http://developer.apple.com/library/mac/#documentation/UserExperience/Reference/Accessibility_RoleAttribute_Ref/Attributes.html
+
  ------------------------------------------------------------------------------}
 function CarbonControl_Accessibility(ANextHandler: EventHandlerCallRef;
   AEvent: EventRef;
   AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
 var
-  lAXRole, lInputStr, lOutputStr: CFStringRef;
+  // Inputs
+  lAXRole, lInputStr: CFStringRef;
   lInputAXObject: AXUIElementRef;
   lInputID64: UInt64;
   lInputAccessibleObject: TLazAccessibleObject;
@@ -178,9 +183,12 @@ var
   lInputMutableArray: CFMutableArrayRef;
   lInputHIPoint: HIPoint;
   lInputPoint: TPoint;
+  // Outputs
+  lOutputStr: CFStringRef;
   lOutputBool: Boolean;
   lOutputInt: SInt64;
   lOutputNum: CFNumberRef;
+  //
   lLazControl: TControl;
   lLazAXRole: TLazAccessibilityRole;
   Command: HICommandExtended;
@@ -192,6 +200,7 @@ var
   i: Integer;
   lAccessibleObj: TLazAccessibleObject;
   lHandle: PtrInt;
+  lSelection: TLazAccessibleObject;
 const SName = 'CarbonControl_Accessibility';
 begin
   {$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
@@ -209,15 +218,9 @@ begin
   // Check if this is an event to a child accessible object
   AXUIElementGetIdentifier(lInputAXObject, lInputID64);
   if (lLazControl is TCustomControl) and (lInputID64 <> 0) then
-  begin
+    lInputAccessibleObject := TLazAccessibleObject(PtrInt(lInputID64))
-    lInputAccessibleObject := TLazAccessibleObject(PtrInt(lInputID64));
+  else lInputAccessibleObject := lLazControl.GetAccessibleObject();
-    lLazAXRole := lLazControl.AccessibleRole;
+  lLazAXRole := lInputAccessibleObject.AccessibleRole;
-  end
-  else
-  begin
-    lInputAccessibleObject := lLazControl.GetAccessibleObject();
-    lLazAXRole := lLazControl.AccessibleRole;
-  end;
 
   EventKind := GetEventKind(AEvent);
   case EventKind of
@@ -234,9 +237,8 @@ begin
       // specified point, in the form of an AXUIElementRef.
       lInputPoint := Types.Point(Round(lInputHIPoint.x), Round(lInputHIPoint.y));
       lInputPoint := TWinControl(lLazControl).ScreenToClient(lInputPoint);
-      lAccessibleObj := lLazControl.GetAccessibleObject();
+      if lInputAccessibleObject = nil then Exit;
-      if lAccessibleObj = nil then Exit;
+      lAccessibleObj := lInputAccessibleObject.GetChildAccessibleObjectAtPos(lInputPoint);
-      lAccessibleObj := lAccessibleObj.GetChildAccessibleObjectAtPos(lInputPoint);
       if (lAccessibleObj = nil) or (lAccessibleObj.Handle = 0) then Exit;
       lHandle := lAccessibleObj.Handle;
       SetEventParameter(AEvent, kEventParamAccessibleChild, typeCFTypeRef,
@@ -266,7 +268,7 @@ begin
         CFArrayAppendValue(lInputMutableArray, lOutputStr);
       end;
       // AXChildren
-      lCount := lLazControl.GetAccessibleObject().GetChildAccessibleObjectsCount;
+      lCount := lInputAccessibleObject.GetChildAccessibleObjectsCount;
       if lCount > 0 then
       begin
         lOutputStr := CFSTR('AXChildren');
@@ -280,6 +282,24 @@ begin
         lOutputStr := CFSTR('AXNumberOfCharacters');
         CFArrayAppendValue(lInputMutableArray, lOutputStr);
       end;
+      // Now elements for each role
+      // AXList
+      if (lLazControl is TCustomControl) and
+        (lLazAXRole in [larListBox, larTreeView]) then
+      begin
+        lOutputStr := CFSTR('AXOrientation');
+        CFArrayAppendValue(lInputMutableArray, lOutputStr);
+        lOutputStr := CFSTR('AXSelectedChildren');
+        CFArrayAppendValue(lInputMutableArray, lOutputStr);
+        lOutputStr := CFSTR('AXVisibleChildren');
+        CFArrayAppendValue(lInputMutableArray, lOutputStr);
+      end;
+      // Basic elements for non-windowed accessible objects
+      if (lLazControl is TCustomControl) and (lInputID64 <> 0) then
+      begin
+        lOutputStr := CFSTR('AXValue');
+        CFArrayAppendValue(lInputMutableArray, lOutputStr);
+      end;
     end; // kEventAccessibleGetAllAttributeNames
     kEventAccessibleGetAllParameterizedAttributeNames:
     begin
@@ -321,12 +341,14 @@ begin
 
       lInputPasStr := CFStringToStr(lInputStr);
 
+      {$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
+        DebugLn('CarbonControl_Accessibility kEventAccessibleGetNamedAttribute kEventParamAccessibleAttributeName=' + lInputPasStr);
+      {$ENDIF}
+
       // AXRole overrides TCustomControl and TCustomWindow values
       if lInputPasStr = 'AXRole' then
       begin
-        if (lLazControl is TWinControl) and (not (lLazControl is TCustomForm))
+        if not (lLazControl is TCustomControl) then Exit;
-          and (not (lLazControl is TCustomControl)) then Exit;
-
         case lLazAXRole of
           larAnimation: lAXRole := CFSTR('AXImage');
           larButton: lAXRole := CFSTR('AXButton');
@@ -366,36 +388,31 @@ begin
 
         Result := noErr;
         Exit;
-      end;
+      end
       // Specially only AXRoleDescription is allowed to override non-TCustomControl values
-      if lInputPasStr = 'AXRoleDescription' then
+      else if lInputPasStr = 'AXRoleDescription' then
       begin
-        if lLazControl.AccessibleDescription = '' then Exit;
+        if lInputAccessibleObject.AccessibleDescription = '' then Exit;
-        CreateCFString(lLazControl.AccessibleDescription, lOutputStr);
+        CreateCFString(lInputAccessibleObject.AccessibleDescription, lOutputStr);
         SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef,
           SizeOf(CFStringRef), @lOutputStr);
         FreeCFString(lOutputStr);
         Result := noErr;
         Exit;
-      end;
+      end
-
+      else if lInputPasStr = 'AXValue' then
-      if not (lLazControl is TCustomControl) then Exit;
-
-      {$IF defined(VerboseControlEvent) or defined(VerboseAccessibilityEvent)}
-        DebugLn('CarbonControl_Accessibility kEventAccessibleGetNamedAttribute kEventParamAccessibleAttributeName=' + lInputPasStr);
-      {$ENDIF}
-
-{      else if lInputPasStr = 'AXValue' then
       begin
-        if lLazControl.AccessibleValue = '' then Exit;
+        if not (lLazControl is TCustomControl) then Exit;
-        CreateCFString(lLazControl.AccessibleValue, lOutputStr);
+        if (lInputID64 = 0) then Exit;
+        CreateCFString(lInputAccessibleObject.AccessibleValue, lOutputStr);
         SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFStringRef,
           SizeOf(CFStringRef), @lOutputStr);
         FreeCFString(lOutputStr);
-      end}
+      end
-      if (lInputPasStr = 'AXNumberOfCharacters') then
+      else if (lInputPasStr = 'AXNumberOfCharacters') then
       begin
-        lOutputInt := UTF8Length(lLazControl.AccessibleValue);
+        if not (lLazControl is TCustomControl) then Exit;
+        lOutputInt := UTF8Length(lInputAccessibleObject.AccessibleValue);
         lOutputNum := CFNumberCreate(nil, kCFNumberSInt64Type, @lOutputInt);
         SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFNumberRef,
           SizeOf(lOutputNum), @lOutputNum);
@@ -405,25 +422,25 @@ begin
       //
       // Parameterized attributes
       //
-      else if (lLazControl is TCustomControl) and (lInputPasStr = 'AXStringForRange') then
+      else if (lInputPasStr = 'AXStringForRange') then
       begin
-        if lLazControl.AccessibleValue = '' then Exit;
+        if not (lLazControl is TCustomControl) then Exit;
-        CreateCFString(lLazControl.AccessibleValue, lOutputStr);
+        if lInputAccessibleObject.AccessibleValue = '' then Exit;
+        CreateCFString(lInputAccessibleObject.AccessibleValue, lOutputStr);
         SetEventParameter(AEvent, kEventParamAccessibleAttributeParameter, typeCFStringRef,
           SizeOf(CFStringRef), @lOutputStr);
         FreeCFString(lOutputStr);
         Result := noErr;
       end
-      else if (lLazControl is TCustomControl) and
+      else if (lInputPasStr = 'AXAttributedStringForRange') or
-        ((lInputPasStr = 'AXAttributedStringForRange') or
          (lInputPasStr = 'AXBoundsForRange') or
          (lInputPasStr = 'AXRangeForIndex') or
          (lInputPasStr = 'AXRangeForLine') or
          (lInputPasStr = 'AXRangeForPosition') or
          (lInputPasStr = 'AXRTFForRange') or
-         (lInputPasStr = 'AXStyleRangeForIndex')
+         (lInputPasStr = 'AXStyleRangeForIndex') then
-        ) then
       begin
+        if not (lLazControl is TCustomControl) then Exit;
         SetEventParameter(AEvent, kEventParamAccessibleAttributeParameter, typeCFTypeRef,
           0, nil);
         Result := noErr;
@@ -431,6 +448,7 @@ begin
       //if (CFStringCompare(lInputStr, kAXFocusedAttribute, 0) = kCFCompareEqualTo) then
       else if lInputPasStr = 'AXFocused' then
       begin
+        //if not (lLazControl is TCustomControl) then Exit;
         if not (lLazControl is TWinControl) then lOutputBool := False
         else if TWinControl(lLazControl).Focused then lOutputBool := True
         else lOutputBool := False;
@@ -444,24 +462,61 @@ begin
 
         Result := noErr;
       end
-      else if (CFStringCompare(lInputStr, CFSTR('AXChildren'), 0) = kCFCompareEqualTo) then // kAXChildrenAttribute
+      //else if (CFStringCompare(lInputStr, CFSTR('AXChildren'), 0) = kCFCompareEqualTo) then // kAXChildrenAttribute
+      else if (lInputPasStr = 'AXChildren') or (lInputPasStr = 'AXVisibleChildren')
+        or (lInputPasStr = 'AXSelectedChildren') then
       begin
         if not (lLazControl is TCustomControl) then Exit;
 
         // Create and return an array of AXUIElements describing the children of this view.
-        lCount := lLazControl.GetAccessibleObject().GetChildAccessibleObjectsCount;
+        if (lInputPasStr = 'AXSelectedChildren') then
+        begin
+          lSelection := lInputAccessibleObject.GetSelectedChildAccessibleObject();
+          if lSelection = nil then
+            lArray := CFArrayCreateMutable(kCFAllocatorDefault, 0, @kCFTypeArrayCallBacks)
+          else
+          begin
+            lArray := CFArrayCreateMutable(kCFAllocatorDefault, 1, @kCFTypeArrayCallBacks);
+            lElement := AXUIElementRef(lSelection.Handle);
+            if lElement <> nil then
+              CFArrayAppendValue(lArray, lElement);
+          end;
+        end
+        else
+        begin
+          lCount := lInputAccessibleObject.GetChildAccessibleObjectsCount;
           lArray := CFArrayCreateMutable(kCFAllocatorDefault, lCount, @kCFTypeArrayCallBacks);
           for i := 0 to lCount - 1 do
           begin
-          lElement := AXUIElementRef(lLazControl.GetAccessibleObject().Handle);
+            lElement := AXUIElementRef(lInputAccessibleObject.Handle);
             if lElement <> nil then
               CFArrayAppendValue(lArray, lElement);
           end;
+        end;
 
         SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFTypeRef,
           SizeOf(lArray), @lArray);
         CFRelease(lArray);
         Result := noErr;
+      end
+      else if lInputPasStr = 'AXOrientation' then
+      begin
+        if not (lLazControl is TCustomControl) then Exit;
+        {$ifdef CarbonUseCocoaAll}
+        SetEventParameter(AEvent, kEventParamAccessibleAttributeParameter, typeCFStringRef,
+          SizeOf(CFStringRef), @NSAccessibilityHorizontalOrientationValue);
+        Result := noErr;
+        {$endif}
+      end
+      else if lInputPasStr = 'AXParent' then
+      begin
+        if lInputID64 = 0 then Exit;
+        if not (lLazControl is TCustomControl) then Exit;
+        if lInputAccessibleObject.Parent = nil then Exit;
+        lElement := AXUIElementRef(lInputAccessibleObject.Parent.Handle);
+        SetEventParameter(AEvent, kEventParamAccessibleAttributeValue, typeCFTypeRef,
+          SizeOf(AXUIElementRef), @lElement);
+        Result := noErr;
       end;
     end; // kEventAccessibleGetNamedAttribute
     kEventAccessibleIsNamedAttributeSettable:
@@ -475,18 +530,22 @@ begin
 
       lInputPasStr := CFStringToStr(lInputStr);
 
-{      // Now elements for each role
+      if (lInputPasStr = 'AXFocused') then
-      // AXStaticText
+      begin
-      if lLazAXRole in [larClock, larLabel, larListItem, larTreeItem] then
+        lOutputBool := TCustomControl(lLazControl).TabStop;
-      begin}
+        SetEventParameter(AEvent, kEventParamAccessibleAttributeSettable, typeBoolean,
-      if (lInputPasStr = 'AXFocused') or (lInputPasStr = 'AXStringForRange') or
+          SizeOf(Boolean), @lOutputBool);
-         (lInputPasStr = 'AXNumberOfCharacters') then
+        Result := noErr;
+      end
+      else if (lInputPasStr = 'AXStringForRange') or
+         (lInputPasStr = 'AXNumberOfCharacters') or (lInputPasStr = 'AXChildren') or
+         (lInputPasStr = 'AXSelectedChildren') or (lInputPasStr = 'AXVisibleChildren') then
       begin
         lOutputBool := False;
         SetEventParameter(AEvent, kEventParamAccessibleAttributeSettable, typeBoolean,
           SizeOf(Boolean), @lOutputBool);
         Result := noErr;
-      end
+      end;
     end; // kEventAccessibleIsNamedAttributeSettable
   end; // case EventKind of
 end;

lcl/interfaces/carbon/carbonwscontrols.pp

@@ -136,7 +136,8 @@ begin
   // Requesting a handle allocation here might be too soon and crash, so cancel the whole action
   if not lWinControl.HandleAllocated then Exit;
 
-  if (AObject.OwnerControl <> nil) and (AObject.OwnerControl is TWinControl) then
+  if (AObject.OwnerControl <> nil) and (AObject.OwnerControl is TWinControl) and
+   (AObject.OwnerControl.GetAccessibleObject() = AObject) then
   begin
     lControlHandle := TCarbonControl(TWinControl(AObject.OwnerControl).Handle);
     AHIObject := lControlHandle.Widget;
@@ -164,6 +165,7 @@ begin
   if lHIObject = nil then Exit;
 
   lElement := AXUIElementCreateWithHIObjectAndIdentifier(lHIObject, lID64);
+  Result := HWND(lElement);
 end;
 
 class procedure TCarbonWSLazAccessibleObject.DestroyHandle(