Tk Source Code

   * Ensure it is unique to that widget.
   */
  hPtr=Tcl_CreateHashEntry(TkAccessibilityObject, win, &isNew);
  if (isNew) {
    AccessibleAttributes = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(AccessibleAttributes,TCL_STRING_KEYS);
    Tcl_SetHashValue(hPtr, AccessibleAttributes);


  }

  /* Set accessible role for window.  */
  hPtr2 =  Tcl_CreateHashEntry(AccessibleAttributes, "role", &isNew);
  if (!isNew) {
    Tcl_DecrRefCount(Tcl_GetHashValue(hPtr2));
  }

/* Define the GUID for the MSAA interface. */
DEFINE_GUID(IID_IAccessible, 0x618736e0, 0x3c3d, 0x11cf, 0x81, 0xc, 0x0, 0xaa, 0x0, 0x38, 0x9b, 0x71);

/* Data declarations used in this file. */
typedef struct {
  IAccessibleVtbl *lpVtbl;

  Tcl_Interp *interp;
  HWND hwnd;
  char *pathName;
  LONG refCount;
} TkWinAccessible;

/* Map script-level roles to C roles. */

  {"Tree", ROLE_SYSTEM_OUTLINE},
  {NULL, 0}
};

/* Hash table for managing accessibility attributes. */
extern Tcl_HashTable *TkAccessibilityObject;

/* Tk window with the accessibility attributes. */
Tk_Window accessible_win;

/* Tcl command passed to event procedure. */
char *callback_command;

/* Focused accessible widget object. */
static LONG g_focusedChildId = 0;

/* Map Tk windows to MSAA ID's. */

void ForceTkWidgetFocus(HWND hwnd, LONG childId);
LONG RegisterTkWidget(Tk_Window tkwin);
LONG GetChildIdForTkWindow(Tk_Window tkwin);
Tk_Window GetTkWindowForChildId(LONG childId);
static HWND GetWidgetHWNDIfPresent(Tk_Window tkwin);
Tk_Window GetToplevelOfWidget(Tk_Window tkwin);
LRESULT CALLBACK TkWinAccessible_WndProc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam);
void InstallCustomWndProcForMSAA(Tk_Window tkwin);
int IsScreenReaderRunning(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const argv[]);
int EmitSelectionChanged(ClientData clientData,Tcl_Interp *ip, int objc, Tcl_Obj *const objv[]);
void TkWinAccessible_RegisterForCleanup(Tk_Window tkwin, void *tkAccessible);
static void TkWinAccessible_DestroyHandler(ClientData clientData, XEvent *eventPtr);
void TkWinAccessible_RegisterForFocus(Tk_Window tkwin, void *tkAccessible);
static void TkWinAccessible_FocusEventHandler (ClientData clientData, XEvent *eventPtr);
int TkWinAccessibleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

/* Function to map accessible name to MSAA.*/
static HRESULT STDMETHODCALLTYPE TkWinAccessible_get_accName(IAccessible *this, VARIANT varChild, BSTR *pszName)
{
  TkWinAccessible *tkAccessible = (TkWinAccessible *)this;

  if (varChild.vt != VT_I4 || varChild.lVal == CHILDID_SELF) {
		
    Tk_Window win = accessible_win;
    Tcl_HashEntry *hPtr, *hPtr2;
    Tcl_HashTable *AccessibleAttributes;
    Tcl_DString ds;
	
    hPtr=Tcl_FindHashEntry(TkAccessibilityObject, win);
    if (!hPtr) {
      return E_INVALIDARG;
    }
	
    /* 
     * Assign the "description" attribute to the name because it is 
     * more detailed - MSAA generally does not provide both the 
     * name and description. 
     */
    AccessibleAttributes = Tcl_GetHashValue(hPtr);
    hPtr2=Tcl_FindHashEntry(AccessibleAttributes, "description");
    if (!hPtr2) {
      return E_INVALIDARG;
    }
	
    char *result = Tcl_GetString(Tcl_GetHashValue(hPtr2));
    Tcl_DStringInit(&ds);
    if (result) {
      *pszName = SysAllocString(Tcl_UtfToWCharDString(result, -1, &ds));
    } else {
      *pszName = SysAllocString(Tcl_UtfToWCharDString(tkAccessible->pathName, -1, &ds));
    }
    Tcl_DStringFree(&ds);
    return S_OK;
  }
  return E_INVALIDARG;
}

/* Function to map accessible role to MSAA.*/

static HRESULT STDMETHODCALLTYPE TkWinAccessible_get_accRole(IAccessible *this, VARIANT varChild, VARIANT *pvarRole)
{
  TkWinAccessible *tkAccessible = (TkWinAccessible *)this;
  LONG role =  0;

  if (!pvarRole) return E_INVALIDARG;

  if (varChild.vt != VT_I4 || varChild.lVal == CHILDID_SELF) {
    Tk_Window win = accessible_win;
		
    Tcl_HashEntry *hPtr, *hPtr2;
    Tcl_HashTable *AccessibleAttributes;
		
    hPtr=Tcl_FindHashEntry(TkAccessibilityObject, win);
    if (!hPtr) {
      return E_INVALIDARG;
    }
		
    AccessibleAttributes = Tcl_GetHashValue(hPtr);




    hPtr2=Tcl_FindHashEntry(AccessibleAttributes, "role");
    if (!hPtr2) {
      return E_INVALIDARG;
    }

    char *result = Tcl_GetString(Tcl_GetHashValue(hPtr2));


    const char *tkrole = NULL;
    if (tkrole) {


      for (int i = 0; roleMap[i].tkrole !=NULL; i++) {
	if (strcmp(roleMap[i].tkrole, tkrole) == 0) {
	  role = roleMap[i].winrole;
	  break;
	}
      }
    }





    pvarRole->vt = VT_I4;
    pvarRole->lVal = role;
    return S_OK;
  }
  return E_INVALIDARG;
}

/* Function to map accessible state to MSAA. */
static HRESULT STDMETHODCALLTYPE TkWinAccessible_get_accState(IAccessible *this, VARIANT varChild, VARIANT *pvarState)
{
  TkWinAccessible *tkAccessible = (TkWinAccessible *)this;
  LONG state;
	
  if (varChild.vt != VT_I4 || varChild.lVal == CHILDID_SELF) {
    /* Check if Tk state is disabled. If so, ignore accessible atribute. */
    Tk_Window win = accessible_win;
    Tcl_HashEntry *hPtr, *hPtr2;
    Tcl_HashTable *AccessibleAttributes;
		
    hPtr=Tcl_FindHashEntry(TkAccessibilityObject, win);
    if (!hPtr) {
      return E_INVALIDARG;
    }
		
    AccessibleAttributes = Tcl_GetHashValue(hPtr);
    hPtr2=Tcl_FindHashEntry(AccessibleAttributes, "state");
    if (!hPtr2) {
      return E_INVALIDARG;
    }
		
    char *result = Tcl_GetString(Tcl_GetHashValue(hPtr2));
    if (strcmp(result, "disabled") == 0) {

static HRESULT STDMETHODCALLTYPE TkWinAccessible_get_accValue(IAccessible *this, VARIANT varChild, BSTR *pszValue)
{
  if (!pszValue) return E_INVALIDARG;
	
  TkWinAccessible *tkAccessible = (TkWinAccessible *)this;
  if (varChild.vt != VT_I4 || varChild.lVal == CHILDID_SELF) {
		
    Tk_Window win = accessible_win;
    Tcl_HashEntry *hPtr, *hPtr2;
    Tcl_HashTable *AccessibleAttributes;
    Tcl_DString ds;
		
    hPtr=Tcl_FindHashEntry(TkAccessibilityObject, win);
    if (!hPtr) {
      return E_INVALIDARG;
    }
		
    AccessibleAttributes = Tcl_GetHashValue(hPtr);
    hPtr2=Tcl_FindHashEntry(AccessibleAttributes, "value");
    if (!hPtr2) {
      return E_INVALIDARG;
    }
		
    char *result = Tcl_GetString(Tcl_GetHashValue(hPtr2));
    if (result) {
      Tcl_DStringInit(&ds);
      *pszValue = SysAllocString(Tcl_UtfToWCharDString(result, -1, &ds));
      Tcl_DStringFree(&ds);
    }
    return S_OK;
  }
  return E_INVALIDARG;
}

/*
 * Function to set Tk toplevel as the primary parent of acccessible 
 * widgets. We want a flat hierarchy to simplify implementation. 
 */
  static HRESULT STDMETHODCALLTYPE TkWinAccessible_get_accParent(IAccessible *this, IDispatch **ppdispParent)
  {
    if (!this || !ppdispParent) return E_INVALIDARG;
  
    TkWinAccessible *tkAccessible = (TkWinAccessible *)this;
    *ppdispParent = NULL;
  
    Tk_Window widget = Tk_NameToWindow(
				       tkAccessible->interp,
				       tkAccessible->pathName,
				       Tk_MainWindow(tkAccessible->interp)
				       );
    if (!widget) return E_FAIL;
  
    /* If this is already a toplevel, it has no parent.*/
    if (Tk_IsTopLevel(widget)) {
      return S_FALSE; /* No parent.*/
    }
  
    /* Otherwise, return the toplevel's accessible object.*/
    Tk_Window toplevel = GetToplevelOfWidget(widget);
    if (!toplevel) return E_FAIL;
  
    const char *toplevelPath = Tk_PathName(toplevel);
    if (!toplevelPath) return E_FAIL;
  
    TkWinAccessible *parentAccessible = create_tk_accessible(
							     tkAccessible->interp,
							     Tk_GetHWND(Tk_WindowId(toplevel)), /* HWND is valid for toplevels.*/
							     toplevelPath
							     );
  
    if (!parentAccessible) return E_OUTOFMEMORY;
  
    *ppdispParent = (IDispatch *)parentAccessible;
  
    ((IAccessible *)parentAccessible)->lpVtbl->AddRef((IAccessible *)parentAccessible);
    return S_OK;
  }
  
/* Function to get number of accessible children to MSAA. */
static HRESULT STDMETHODCALLTYPE TkWinAccessible_get_accChildCount(IAccessible *this, LONG *pcChildren)
{
    if (!pcChildren || !this) return E_INVALIDARG;

    TkWinAccessible *tkAccessible = (TkWinAccessible *)this;

    Tk_Window toplevel = Tk_NameToWindow(
        tkAccessible->interp,
        tkAccessible->pathName,
        Tk_MainWindow(tkAccessible->interp)
    );
    if (!toplevel || !Tk_IsTopLevel(toplevel)) {
        return E_FAIL;
    }

    int count = 0;
    TkWindow *winPtr = (TkWindow *)toplevel;

    for (TkWindow *child = winPtr->childList; child != NULL; child = child->nextPtr) {
        if (!Tk_IsMapped((Tk_Window)child)) continue;

        const char *className = Tk_Class((Tk_Window)child);
        if (className && strcmp(className, "Menu") == 0) continue;

        count++;
    }

    *pcChildren = count;
    return S_OK;
}


/* Function to get accessible children to MSAA. */
static HRESULT STDMETHODCALLTYPE TkWinAccessible_get_accChild(IAccessible *this, VARIANT varChild, IDispatch **ppdispChild)
{
    if (!this || !ppdispChild) {
        return E_INVALIDARG;
    }

    *ppdispChild = NULL;

    if (varChild.vt != VT_I4 || varChild.lVal <= 0) {
        return E_INVALIDARG;
    }

    TkWinAccessible *tkAccessible = (TkWinAccessible *)this;

    /* Resolve the toplevel window from the stored pathName. */
    Tk_Window toplevel = Tk_NameToWindow(tkAccessible->interp, tkAccessible->pathName, Tk_MainWindow(tkAccessible->interp));
    if (!toplevel || !Tk_IsTopLevel(toplevel)) {
        return E_FAIL;
    }

    /* Enumerate mapped, non-menu children. */
    int index = 0;
    TkWindow *winPtr = (TkWindow *)toplevel;

    for (TkWindow *child = winPtr->childList; child != NULL; child = child->nextPtr) {
        if (!Tk_IsMapped((Tk_Window)child)) continue;

        const char *className = Tk_Class((Tk_Window)child);
        if (className && strcmp(className, "Menu") == 0) continue;

        index++;
        if (index == varChild.lVal) {
            TkWinAccessible *childAccessible = create_tk_accessible(
                tkAccessible->interp,
                GetWidgetHWNDIfPresent((Tk_Window)child), /*hwnd if valid*/
                Tk_PathName((Tk_Window)child)
            );

            if (!childAccessible) return E_OUTOFMEMORY;

            *ppdispChild = (IDispatch *)childAccessible;

            /* Increase reference count to match COM expectations. */
            ((IAccessible *)childAccessible)->lpVtbl->AddRef((IAccessible *)childAccessible);

            return S_OK;
        }
    }
    return E_INVALIDARG;
}

/* Function to get accessible frame to MSAA. */
static HRESULT STDMETHODCALLTYPE TkWinAccessible_accLocation(IAccessible *this, LONG *pxLeft, LONG *pyTop, LONG *pcxWidth, LONG *pcyHeight, VARIANT varChild)
{
  TkWinAccessible *tkAccessible = (TkWinAccessible *)this;
  if (varChild.vt != VT_I4 || varChild.lVal == CHILDID_SELF) {

  return E_INVALIDARG;
}

/* Function to get button press to MSAA. */
static HRESULT STDMETHODCALLTYPE TkWinAccessible_accDoDefaultAction(IAccessible *this, VARIANT varChild)
{
  TkWinAccessible *tkAccessible = (TkWinAccessible *)this;  
  Tk_Window win = accessible_win;
  Tcl_HashEntry *hPtr, *hPtr2;
  Tcl_HashTable *AccessibleAttributes;
  Tcl_Event *event; 

  hPtr=Tcl_FindHashEntry(TkAccessibilityObject, win);
  if (!hPtr) {
    return E_INVALIDARG;

  return S_OK;  
}

/*
 * Event proc which implements the action event procedure.
 */

 static int TkWinAccessible_ActionEventHandler(Tcl_Event *evtPtr, int flags)
{
  /* MSVC complains about TCL_UNUSED. */
  (void)evtPtr;
  (void)flags;

  TkMainInfo *info = TkGetMainInfoList();
  Tcl_GlobalEval(info->interp, callback_command);
  return 1;
}

/* Function to get accessible help to MSAA. */
static HRESULT STDMETHODCALLTYPE TkWinAccessible_get_accHelp(IAccessible *this, VARIANT varChild, BSTR* pszHelp)
{
  if (varChild.vt != VT_I4 || varChild.lVal != CHILDID_SELF) {
    return E_INVALIDARG;
  }


  Tk_Window win = accessible_win;
  Tcl_HashEntry *hPtr, *hPtr2;
  Tcl_HashTable *AccessibleAttributes;
  Tcl_DString ds;
		
  hPtr=Tcl_FindHashEntry(TkAccessibilityObject, win);
  if (!hPtr) {
    return E_INVALIDARG;

  if (!*pszHelp) {
    return E_OUTOFMEMORY;
  }

  return S_OK;
}


static STDMETHODIMP TkWinAccessible_get_accFocus(IAccessible *this, VARIANT *pvarChild)
{
  if (!pvarChild) return E_INVALIDARG;
  VariantInit(pvarChild);

  /* Return the currently focused child ID.*/
  LONG focusedId  = g_focusedChildId;

  return S_OK;
}

static HRESULT STDMETHODCALLTYPE TkWinAccessible_get_accDescription(IAccessible *this, VARIANT varChild, BSTR *pszDescription)
{


  Tk_Window win = accessible_win;
  Tcl_HashEntry *hPtr, *hPtr2;
  Tcl_HashTable *AccessibleAttributes;
  Tcl_DString ds;
		
  hPtr=Tcl_FindHashEntry(TkAccessibilityObject, win);
  if (!hPtr) {
    return E_INVALIDARG;

/*Function to check if a Tk widget (i.e. ttk widget) has a HWND.*/
static HWND GetWidgetHWNDIfPresent(Tk_Window tkwin) {
  if (!tkwin || !Tk_IsMapped(tkwin)) return NULL;

  Window winId = Tk_WindowId(tkwin);
  if (winId == None) return NULL;

  HWND hwnd = Tk_GetHWND(winId);
  if (hwnd && IsWindow(hwnd)) {
    return hwnd;
  }

  return NULL;
}


/* Function to return the Tk toplevel window that contains a given Tk widget. */
Tk_Window GetToplevelOfWidget(Tk_Window tkwin)
{

  while (!Tk_IsTopLevel(tkwin)) {
    tkwin = Tk_Parent(tkwin);
      if (tkwin == NULL) {
          return NULL; // Reached the top without finding a toplevel window
        }
    }
  return tkwin;
}

/* Custom WndProc to handle WM_GETOBJ so MSAA responds to Tk accessibility. */
LRESULT CALLBACK TkWinAccessible_WndProc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
{
  if (msg == WM_GETOBJECT && lParam == OBJID_CLIENT) {

  if (data && data->originalWndProc) {
    return CallWindowProc(data->originalWndProc, hwnd, msg, wParam, lParam);
  }

  return DefWindowProc(hwnd, msg, wParam, lParam);
}

/* Install custom WndProc. */
void InstallCustomWndProcForMSAA(Tk_Window tkwin)
{
  if (!tkwin || !Tk_IsTopLevel(tkwin)) return;

  HWND hwnd = Tk_GetHWND(Tk_WindowId(tkwin));
  if (!hwnd) return;

  /* Check if we've already installed the custom WndProc. */
  TkWinAccessibleWndData *existing = (TkWinAccessibleWndData *)GetWindowLongPtr(hwnd, GWLP_USERDATA);
  if (existing && existing->originalWndProc == TkWinAccessible_WndProc) {
    return; // already set
  }

  /* Store original WndProc and hook ours. */
  WNDPROC original = (WNDPROC)GetWindowLongPtr(hwnd, GWLP_WNDPROC);
  TkWinAccessibleWndData *data = (TkWinAccessibleWndData *)ckalloc(sizeof(TkWinAccessibleWndData));
  data->originalWndProc = original;
  data->hwnd = hwnd;

  SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR)data);
  SetWindowLongPtr(hwnd, GWLP_WNDPROC, (LONG_PTR)TkWinAccessible_WndProc);
}

/*
 *----------------------------------------------------------------------
 *
 * IsScreenReaderRunning --
 *
 * Runtime check to see if screen reader is running. 
 *

  Tk_Window path;
	
  path = Tk_NameToWindow(ip, Tcl_GetString(objv[1]), Tk_MainWindow(ip));
  if (path == NULL) {
    Tk_MakeWindowExist(path);
  }
	
  accessible_win = path;
	
  /* Fire notification of new value. */
  HWND hwnd = Tk_GetHWND(Tk_WindowId(accessible_win));
  NotifyWinEvent(EVENT_OBJECT_VALUECHANGE, hwnd, OBJID_CLIENT, 0);
	
  return TCL_OK;
}



/*
 *----------------------------------------------------------------------
 *
 * TkWinAccessible_RegisterForCleanup --
 *
 * Register event handler for destroying accessibility element.

 */

void TkWinAccessible_RegisterForFocus(Tk_Window tkwin, void *tkAccessible)
{
  Tk_CreateEventHandler(tkwin, FocusChangeMask, 
			TkWinAccessible_FocusEventHandler, tkAccessible);
}


/*
 *----------------------------------------------------------------------
 *
 * TkWinAccessibleObjCmd --
 *
 *	Main command for adding and managing accessibility objects to Tk

  Tk_Window tkwin = Tk_NameToWindow(interp, windowName, Tk_MainWindow(interp));

  if (tkwin == NULL) {
    Tcl_SetResult(interp, "Invalid window name.", TCL_STATIC);
    return TCL_ERROR;
  }

  accessible_win = tkwin;

  HWND hwnd = Tk_GetHWND(Tk_WindowId(tkwin));
  InstallCustomWndProcForMSAA(tkwin);
  TkWinAccessible *accessible = create_tk_accessible(interp, hwnd, windowName);
  TkWinAccessible_RegisterForCleanup(tkwin, accessible);
  TkWinAccessible_RegisterForFocus(tkwin, accessible);

	
  if (accessible == NULL) {		
    Tcl_SetResult(interp, "Failed to create accessible object.", TCL_STATIC);
    return TCL_ERROR;
  }
  return TCL_OK;
} 

/*
 *----------------------------------------------------------------------
 *
 * TkWinAccessibility_Init --
 *
 *	Initializes the accessibility module.