1/* -*- mode: C; coding: macintosh; -*-
2 * ###################################################################
3 *  TclAE - AppleEvent extension for Tcl
4 *
5 *  FILE: "tclAEObjects.c"
6 *                                    created: 11/13/00 {10:30:29 PM}
7 *                                last update: 7/26/10 {2:15:27 AM}
8 *  Author: Jonathan Guyer
9 *  E-mail: jguyer@his.com
10 *    mail: Alpha Cabal
11 *          POMODORO no seisan
12 *     www: http://www.his.com/jguyer/
13 *
14 * ========================================================================
15 *               Copyright � 2000 Jonathan Guyer
16 *                      All rights reserved
17 * ========================================================================
18 * Permission to use, copy, modify, and distribute this software and its
19 * documentation for any purpose and without fee is hereby granted,
20 * provided that the above copyright notice appear in all copies and that
21 * both that the copyright notice and warranty disclaimer appear in
22 * supporting documentation.
23 *
24 * Jonathan Guyer disclaims all warranties with regard to this software,
25 * including all implied warranties of merchantability and fitness.  In
26 * no event shall Jonathan Guyer be liable for any special, indirect or
27 * consequential damages or any damages whatsoever resulting from loss of
28 * use, data or profits, whether in an action of contract, negligence or
29 * other tortuous action, arising out of or in connection with the use or
30 * performance of this software.
31 * ========================================================================
32 *  See header file for further information
33 * ###################################################################
34 */
35
36#ifndef _TCL
37#include <tcl.h>
38#endif
39
40#ifdef TCLAE_USE_FRAMEWORK_INCLUDES
41#include <Carbon/Carbon.h>
42#else
43#include <AEObjects.h>
44#endif
45
46#include <string.h>
47
48#include "tclAEInt.h"
49#include "tclMacOSError.h"
50
51/* I don't claim that I understand why, by gInterp will retain different
52 * values for different applications that invoke TclAE. This is fortunate
53 * because the slugs at Apple were too lazy to provide a refcon field
54 * in the object callbacks.
55 */
56
57static Tcl_Interp * gInterp;
58static AEDesc		gErrorDesc;
59
60
61/* Hash table for storage of object accessors */
62static Tcl_HashTable *		tclAEObjectAccessorHashTable;
63
64static OSLAccessorUPP 		TclaeObjectAccessorUPP = NULL;
65static OSLCompareUPP		TclaeCompareObjectsUPP = NULL;
66static OSLCountUPP			TclaeCountObjectsUPP = NULL;
67static OSLDisposeTokenUPP	TclaeDisposeTokenUPP = NULL;
68static OSLGetMarkTokenUPP	TclaeGetMarkTokenUPP = NULL;
69static OSLMarkUPP			TclaeMarkUPP = NULL;
70static OSLAdjustMarksUPP	TclaeAdjustMarksUPP = NULL;
71static OSLGetErrDescUPP		TclaeGetErrorDescUPP = NULL;
72
73typedef struct tclAEObjectAccessor {
74	DescType	desiredClass;
75	DescType	containerType;
76	Tcl_Obj		*accessorProc;
77	Tcl_Interp	*interp;
78} tclAEObjectAccessor;
79
80static Tcl_HashEntry* TclaeGetObjectAccessor(Tcl_Interp* interp, DescType desiredClass, DescType containerType, char* accessorProc);
81
82static pascal OSErr TclaeObjectAccessor(DescType desiredClass, const AEDesc *containerToken, DescType containerClass, DescType keyForm, const AEDesc *keyData, AEDesc *theToken, long theRefcon);
83static pascal OSErr TclaeCountObjects(DescType desiredClass, DescType containerClass, const AEDesc *theContainer, long *result);
84static pascal OSErr TclaeCompareObjects(DescType comparisonOperator, const AEDesc *theObject, const AEDesc *objectOrDescToCompare, Boolean *result);
85static pascal OSErr TclaeDisposeToken(AEDesc *unneededToken);
86static pascal OSErr TclaeGetErrorDesc(AEDescPtr *errDescPtr);
87static pascal OSErr TclaeGetMarkToken(const AEDesc *containerToken, DescType containerClass, AEDesc *result);
88static pascal OSErr TclaeMark(const AEDesc *theToken, const AEDesc *markToken, long markCount);
89static pascal OSErr TclaeAdjustMarks(long newStart, long newStop, const AEDesc *markToken);
90
91static OSErr TclaeRemoveObjectAccessor(DescType desiredClass, DescType containerType, Tcl_HashEntry * hashEntryPtr);
92
93
94/*
95 * -------------------------------------------------------------------------
96 *
97 * "Tclae_SetObjectCallbacksCmd" --
98 *
99 *  Tcl wrapper for ToolBox AESetObjectCallbacks call.
100 *
101 * Argument     Default In/Out Description
102 * ------------ ------- ------ ---------------------------------------------
103 *  clientData					(unused)
104 *  interp				In		for results
105 *  objc				In		number of arguments
106 *  objv				In		argument objects
107 *
108 * Results:
109 *  �
110 *
111 * Side effects:
112 *  �
113 *
114 * --Version--Author------------------Changes-------------------------------
115 *    1.0     jguyer@his.com original
116 * -------------------------------------------------------------------------
117 */
118int
119Tclae_SetObjectCallbacksCmd(ClientData clientData,
120		                 Tcl_Interp *interp,
121		                 int objc,
122		                 Tcl_Obj *const objv[])
123{
124	OSErr		err;					/* result from ToolBox calls */
125//	int			result;					/* result from Tcl calls */
126	Tcl_Obj *	procObj;
127
128	enum {
129		kCompareProc = 1,
130		kCountProc,
131		kDisposeTokenProc,
132		kGetMarkTokenProc,
133		kMarkProc,
134		kAdjustMarksProc,
135		kTotalArguments
136	};
137
138	if (objc != kTotalArguments) {
139		Tcl_WrongNumArgs(interp, 1, objv, "<compareProc> <countProc> <disposeTokenProc> <getMarkTokenProc> <markProc> <adjustMarksProc>");
140		return TCL_ERROR;
141	}
142
143	gInterp = interp;
144
145    // All compare callbacks are relayed through TclaeCompareObjects()
146	procObj = Tcl_SetVar2Ex(interp, "tclAE::_callbacks", "compareObjects", objv[kCompareProc], TCL_GLOBAL_ONLY);
147    if (Tcl_GetCharLength(procObj) > 0) {
148		if (!TclaeCompareObjectsUPP) {
149			TclaeCompareObjectsUPP = NewOSLCompareUPP(TclaeCompareObjects);
150		}
151	} else {
152		DisposeOSLCompareUPP(TclaeCompareObjectsUPP);
153	}
154
155    // All count callbacks are relayed through TclaeCountObjects()
156	procObj = Tcl_SetVar2Ex(interp, "tclAE::_callbacks", "countObjects", objv[kCountProc], TCL_GLOBAL_ONLY);
157    if (Tcl_GetCharLength(procObj) > 0) {
158		if (!TclaeCountObjectsUPP) {
159			TclaeCountObjectsUPP = NewOSLCountUPP(TclaeCountObjects);
160		}
161	} else {
162		DisposeOSLCountUPP(TclaeCountObjectsUPP);
163	}
164
165    // All dispose token callbacks are relayed through TclaeDisposeToken()
166	procObj = Tcl_SetVar2Ex(interp, "tclAE::_callbacks", "disposeToken", objv[kDisposeTokenProc], TCL_GLOBAL_ONLY);
167    if (Tcl_GetCharLength(procObj) > 0) {
168		if (!TclaeDisposeTokenUPP) {
169			TclaeDisposeTokenUPP = NewOSLDisposeTokenUPP(TclaeDisposeToken);
170		}
171	} else {
172		DisposeOSLDisposeTokenUPP(TclaeDisposeTokenUPP);
173	}
174
175    // All get mark token callbacks are relayed through TclaeGetMarkToken()
176	procObj = Tcl_SetVar2Ex(interp, "tclAE::_callbacks", "getMarkToken", objv[kGetMarkTokenProc], TCL_GLOBAL_ONLY);
177    if (Tcl_GetCharLength(procObj) > 0) {
178		if (!TclaeGetMarkTokenUPP) {
179			TclaeGetMarkTokenUPP = NewOSLGetMarkTokenUPP(TclaeGetMarkToken);
180		}
181	} else {
182		DisposeOSLGetMarkTokenUPP(TclaeGetMarkTokenUPP);
183	}
184
185    // All mark callbacks are relayed through TclaeMark()
186	procObj = Tcl_SetVar2Ex(interp, "tclAE::_callbacks", "mark", objv[kMarkProc], TCL_GLOBAL_ONLY);
187    if (Tcl_GetCharLength(procObj) > 0) {
188		if (!TclaeMarkUPP) {
189			TclaeMarkUPP = NewOSLMarkUPP(TclaeMark);
190		}
191	} else {
192		DisposeOSLMarkUPP(TclaeMarkUPP);
193	}
194
195    // All adjust marks callbacks are relayed through TclaeAdjustMarks()
196	procObj = Tcl_SetVar2Ex(interp, "tclAE::_callbacks", "adjustMarks", objv[kAdjustMarksProc], TCL_GLOBAL_ONLY);
197    if (Tcl_GetCharLength(procObj) > 0) {
198		if (!TclaeAdjustMarksUPP) {
199			TclaeAdjustMarksUPP = NewOSLAdjustMarksUPP(TclaeAdjustMarks);
200		}
201	} else {
202		DisposeOSLAdjustMarksUPP(TclaeAdjustMarksUPP);
203	}
204
205    // All get error desc callbacks are handled by TclaeGetErrorDesc()
206	if (!TclaeGetErrorDescUPP) {
207		TclaeGetErrorDescUPP = NewOSLGetErrDescUPP(TclaeGetErrorDesc);
208	}
209
210	err = AESetObjectCallbacks(TclaeCompareObjectsUPP,
211								TclaeCountObjectsUPP,
212								TclaeDisposeTokenUPP,
213								TclaeGetMarkTokenUPP,
214								TclaeMarkUPP,
215								TclaeAdjustMarksUPP,
216								TclaeGetErrorDescUPP);
217
218	if (err != noErr) {
219		Tcl_ResetResult(interp);
220		Tcl_AppendResult(interp, "Couldn't set object callbacks: ",
221						 Tcl_MacOSError(interp, err),
222						 (char *) NULL);
223        return TCL_ERROR;
224	}
225
226	return TCL_OK;
227}
228
229/*
230 * -------------------------------------------------------------------------
231 *
232 * "Tclae_ResolveCmd" --
233 *
234 *
235 *
236 * Argument     Default In/Out Description
237 * ------------ ------- ------ ---------------------------------------------
238 *  clientData					(unused)
239 *  interp				In		for results
240 *  objc				In		number of arguments
241 *  objv				In		argument objects
242 *
243 * Results:
244 *  �
245 *
246 * Side effects:
247 *  �
248 *
249 * --Version--Author------------------Changes-------------------------------
250 *    1.0     jguyer@his.com original
251 * -------------------------------------------------------------------------
252 */
253int
254Tclae_ResolveCmd(ClientData clientData,
255                 Tcl_Interp *interp,
256                 int objc,
257                 Tcl_Obj *const objv[])
258{
259	OSErr			err;					/* result from ToolBox calls */
260	int				result;					/* result from Tcl calls */
261    int				j;						/* object variable counter */
262    const AEDesc *	objectSpecifier;		/* object specifier record to be resolved */
263    AEDesc *		theTokenPtr;      		/* to hold newly created Token */
264    short			callbackFlags = kAEIDoMinimum;
265    										/* additional assistance app can provide AEM */
266	char *			arg;					/* for option arguments */
267
268	/* Scan optional flags */
269	for (j = 1; (j < objc) && ((arg = Tcl_GetString(objv[j]))[0] == '-') && (arg[1] != '-'); j++) {
270		switch (arg[1]) {
271          case 'm':
272            callbackFlags |= kAEIDoMarking;
273            break;
274          case 'w':
275            callbackFlags |= kAEIDoWhose;
276            break;
277		}
278	}
279
280	if (objc < (j + 1)) {
281		Tcl_WrongNumArgs(interp, 1, objv, "?options? <objectSpecifier>");
282		return TCL_ERROR;
283	}
284
285	/* objv[1] holds hash key for original descriptor */
286	result = Tclae_GetConstAEDescFromObj(interp, objv[j], &objectSpecifier, true);
287	if (result != TCL_OK) {
288		return TCL_ERROR;
289	}
290
291	/* allocate space for new AEDesc */
292    theTokenPtr = (AEDesc *) ckalloc(sizeof(AEDesc));
293
294    err = AEResolve(objectSpecifier, callbackFlags, theTokenPtr);
295
296	if (err != noErr) {
297		ckfree((char *) theTokenPtr);
298		Tcl_ResetResult(interp);
299		Tcl_AppendResult(interp, "Couldn't resolve object \"",
300						 Tcl_GetString(objv[1]), "\": ",
301						 Tcl_MacOSError(interp, err),
302						 (char *) NULL);
303        return TCL_ERROR;
304	} else {
305		Tcl_SetObjResult(interp, Tclae_NewAEDescObj(theTokenPtr));
306		return TCL_OK;
307	}
308}
309
310/*
311 * -------------------------------------------------------------------------
312 *
313 * "Tclae_CallObjectAccessorCmd" --
314 *
315 *  Tcl wrapper for ToolBox AECallObjectAccessor call.
316 *
317 *  tclAE::callObjectAccessor <desiredClass> <containerToken> <containerClass> <keyForm> <keyData>
318 *
319 * Argument     Default In/Out Description
320 * ------------ ------- ------ ---------------------------------------------
321 *  clientData					(unused)
322 *  interp				In		for results
323 *  objc				In		number of arguments
324 *  objv				In		argument objects
325 *
326 * Results:
327 *  Tcl result code
328 *
329 * Side effects:
330 *  result of interp is set to hash key for new token
331 * -------------------------------------------------------------------------
332 */
333int
334Tclae_CallObjectAccessorCmd(ClientData clientData,	/* (unused) */
335							Tcl_Interp *interp,		/* for results */
336							int objc,				/* number of arguments */
337							Tcl_Obj *const objv[])	/* argument objects */
338{
339	OSErr       	err;						/* result from ToolBox calls */
340	int				result;						/* result from Tcl calls */
341	const AEDesc *	containerToken;				/* the containing AEDesc */
342	const AEDesc *	keyData;					/* the AEDesc containing object */
343	AEDesc *		tokenPtr = NULL;			/* pointer to new token */
344
345	enum {
346		kDesiredType = 1,
347		kContainerToken,
348		kContainerClass,
349		kKeyForm,
350		kKeyData,
351		kTotalArguments
352	};
353
354	if (objc != kTotalArguments) {
355		Tcl_WrongNumArgs(interp, 1, objv, "<desiredClass> <containerToken> <containerClass> <keyForm> <keyData>");
356		return TCL_ERROR;
357	}
358
359	/* objv[kContainerToken] holds reference for the container */
360	result = Tclae_GetConstAEDescFromObj(interp, objv[kContainerToken], &containerToken, true);
361	if (result != TCL_OK) {
362		return TCL_ERROR;
363	}
364	/* objv[kKeyData] holds reference for the key data */
365	result = Tclae_GetConstAEDescFromObj(interp, objv[kKeyData], &keyData, true);
366	if (result != TCL_OK) {
367		return TCL_ERROR;
368	}
369
370	/* Allocate the coerced AEDesc */
371    tokenPtr = (AEDesc *) ckalloc(sizeof(AEDesc));
372	if (tokenPtr == NULL) {
373		return TCL_ERROR;
374	}
375
376	err = AECallObjectAccessor(TclaeGetOSTypeFromObj(objv[kDesiredType]),
377							   containerToken,
378							   TclaeGetOSTypeFromObj(objv[kContainerClass]),
379							   TclaeGetOSTypeFromObj(objv[kKeyForm]),
380							   keyData,
381							   tokenPtr);
382
383	if (err != noErr) {
384		ckfree((char *)tokenPtr);
385		Tcl_ResetResult(interp);
386		Tcl_AppendResult(interp, "Couldn't call object accessor: ",
387						 Tcl_MacOSError(interp, err),
388						 (char *) NULL);
389        return TCL_ERROR;
390	} else {
391        Tcl_SetObjResult(interp, Tclae_NewAEDescObj(tokenPtr));
392        return TCL_OK;
393	}
394}
395
396/*
397 * -------------------------------------------------------------------------
398 *
399 * "Tclae_GetObjectAccessorCmd" --
400 *
401 *  Tcl wrapper for ToolBox AEGetObjectAccessorr call.
402 *  This returns the Tcl proc that has been installed as an object accessor.
403 *
404 *  tclAE::getObjectAccessor <desiredClass> <containerType>
405 *
406 * Argument     Default In/Out Description
407 * ------------ ------- ------ ---------------------------------------------
408 *  clientData					(unused)
409 *  interp				In		for results
410 *  objc				In		number of arguments
411 *  objv				In		argument objects
412 *
413 * Results:
414 *  Tcl result code
415 *
416 * Side effects:
417 *  result of interp is set to registered <handlerProc>
418 *  or errAEAccessorNotFound if none
419 *
420 * --Version--Author------------------Changes-------------------------------
421 *    1.0     jguyer@his.com original
422 * -------------------------------------------------------------------------
423 */
424int
425Tclae_GetObjectAccessorCmd(ClientData clientData,
426                           Tcl_Interp *interp,
427                           int objc,
428                           Tcl_Obj *const objv[])
429{
430	DescType				desiredClass;
431	DescType				containerType;
432	Tcl_HashEntry *			hashEntryPtr;	/* for entry in coercion handler hash table */
433    OSErr					err;
434
435	OSLAccessorUPP			accessor;
436        SRefCon 				accessorRefcon;
437
438	if (objc != 3) {
439		Tcl_WrongNumArgs(interp, 1, objv, "<desiredClass> <containerType>");
440		return TCL_ERROR;
441	}
442
443	desiredClass = TclaeGetOSTypeFromObj(objv[1]);
444	containerType = TclaeGetOSTypeFromObj(objv[2]);
445
446	hashEntryPtr = TclaeGetObjectAccessor(interp, desiredClass, containerType, NULL);
447
448	if (hashEntryPtr == NULL) {
449		// Check if there's a non-Tcl coercion handler registered in
450		// the application handler table.
451		// If there is, return nothing.
452		err = AEGetObjectAccessor(desiredClass,
453                                  containerType,
454                                  &accessor,
455                                  &accessorRefcon,
456                                  false);
457		if (err == errAEAccessorNotFound) {
458			// Check if there's a non-Tcl coercion handler registered in
459			// the system handler table.
460			// If there is, return nothing.
461			err = AEGetObjectAccessor(desiredClass,
462                                      containerType,
463                                      &accessor,
464                                      &accessorRefcon,
465                                      true);
466		}
467	} else {
468		tclAEObjectAccessor*	accessorPtr = Tcl_GetHashValue(hashEntryPtr);
469
470	    // Ensure this accessor is actually registered with the AEM
471		err = AEGetObjectAccessor(desiredClass,
472                                  containerType,
473                                  &accessor,
474                                  &accessorRefcon,
475                                  false);
476
477	    if ((err != noErr)
478	    ||	(accessor != (OSLAccessorUPP)TclaeObjectAccessorUPP)
479	    ||	(accessorRefcon != (SRefCon) accessorPtr)) {
480	    	// Something is severely wrong.
481	    	// The accessor in the accessor hash table is either not
482	    	// registered with the AEM at all, or it is inconsistent
483	    	// with what the AEM thinks it is.
484
485	    	// Delete this coercion hash entry.
486	    	TclaeRemoveObjectAccessor(desiredClass, containerType, hashEntryPtr);
487
488	    	if (err == noErr) {
489	    		// The AEM didn't report an error, but something was
490	    		// wrong anyway. Report handler not found.
491		    	err = errAEAccessorNotFound;
492		    }
493	    } else {
494	    	// Return <handlerProc>
495	    	Tcl_Obj *accessorProcPtr = accessorPtr->accessorProc;
496
497	    	// Keep interpreter from deleting it
498	    	Tcl_IncrRefCount(accessorProcPtr);
499
500			Tcl_SetObjResult(interp, accessorProcPtr);
501	    }
502	}
503
504	if (err != noErr) {
505		Tcl_ResetResult(interp);
506		Tcl_AppendResult(interp, "Couldn't find object accessor: ",
507						 Tcl_MacOSError(interp, err),
508						 (char *) NULL);
509		return TCL_ERROR;
510	} else {
511		return TCL_OK;
512	}
513}
514
515/*
516 * -------------------------------------------------------------------------
517 *
518 * "Tclae_InstallObjectAccessorCmd" --
519 *
520 *  Tcl wrapper for ToolBox AEInstallObjectAccessor call.
521 *  This allows Tcl procs to act as object accessors.
522 *
523 *  tclAE::installObjectAccessor <desiredClass> <containerType> <theAccessor>
524 *
525 * Argument     Default In/Out Description
526 * ------------ ------- ------ ---------------------------------------------
527 *  clientData					(unused)
528 *  interp				In		for results
529 *  objc				In		number of arguments
530 *  objv				In		argument objects
531 *
532 * Results:
533 *  Tcl result code
534 *
535 * Side effects:
536 *  <theAccessor> is registered and added to the object accessor hash
537 *
538 * --Version--Author------------------Changes-------------------------------
539 *    1.0     jguyer@his.com original
540 * -------------------------------------------------------------------------
541 */
542int
543Tclae_InstallObjectAccessorCmd(ClientData clientData,
544                               Tcl_Interp *interp,
545                               int objc,
546                               Tcl_Obj *const objv[])
547{
548	DescType				desiredClass;
549	DescType				containerType;
550	tclAEObjectAccessor *	objectAccessorPtr;
551	Tcl_HashEntry *			hashEntryPtr;	/* for entry in object accessor hash table */
552    OSErr					err;
553    int             		isNew;			/* is hash already used
554											   (shouldn't be!) */
555
556	if (objc != 4) {
557		Tcl_WrongNumArgs(interp, 1, objv, "<desiredClass> <containerType> <theAccessor>");
558		return TCL_ERROR;
559	}
560
561    // As far as the AEM is concerned, all registered accessors are handled by
562    // TclaeObjectAccessor()
563	if (!TclaeObjectAccessorUPP) {
564		TclaeObjectAccessorUPP = NewOSLAccessorUPP(TclaeObjectAccessor);
565	}
566
567	desiredClass = TclaeGetOSTypeFromObj(objv[1]);
568	containerType = TclaeGetOSTypeFromObj(objv[2]);
569
570	hashEntryPtr = TclaeGetObjectAccessor(interp, desiredClass, containerType, NULL);
571
572	if (hashEntryPtr == NULL) {
573        // Not found. Create a new hash entry for this accessor
574
575		objectAccessorPtr = (tclAEObjectAccessor *) ckalloc(sizeof(tclAEObjectAccessor));
576		objectAccessorPtr->desiredClass = desiredClass;
577		objectAccessorPtr->containerType = containerType;
578
579		// No need to check isNew because that's the only reason we're here
580		hashEntryPtr = Tcl_CreateHashEntry(tclAEObjectAccessorHashTable,
581										   (char *) objectAccessorPtr,
582										   &isNew);
583		if (isNew) {
584			// Set hash entry to point at the accessor record
585			Tcl_SetHashValue(hashEntryPtr, objectAccessorPtr);
586		}
587	} else {
588        // Found. Get the existing handler from the hash entry.
589		objectAccessorPtr = (tclAEObjectAccessor *) Tcl_GetHashValue(hashEntryPtr);
590	}
591
592    // Assign the Tcl proc which is to handle this accessor
593	objectAccessorPtr->interp = interp;
594	objectAccessorPtr->accessorProc = objv[3];
595    // Keep proc from being deleted by the interpreter
596	Tcl_IncrRefCount(objv[3]);
597
598    // Register this accessor with the AEM
599	err = AEInstallObjectAccessor(desiredClass,
600								  containerType,
601                                  TclaeObjectAccessorUPP,
602                                  (SRefCon) objectAccessorPtr,
603                                  false);
604	if (err != noErr) {
605		Tcl_ResetResult(interp);
606		Tcl_AppendResult(interp, "Couldn't install object accessor: ",
607						 Tcl_MacOSError(interp, err),
608						 (char *) NULL);
609		return TCL_ERROR;
610	} else {
611		return TCL_OK;
612	}
613}
614
615/*
616 * -------------------------------------------------------------------------
617 *
618 * "Tclae_RemoveObjectAccessorCmd" --
619 *
620 *  Tcl wrapper for ToolBox AERemoveObjectAccessor call.
621 *  This removes a Tcl proc that has been installed as an object accessor.
622 *
623 *  tclAE::removeObjectAccessor <desiredClass> <containerType> <theAccessor>
624 *
625 * Argument     Default In/Out Description
626 * ------------ ------- ------ ---------------------------------------------
627 *  clientData					(unused)
628 *  interp				In		for results
629 *  objc				In		number of arguments
630 *  objv				In		argument objects
631 *
632 * Results:
633 *  Tcl result code
634 *
635 * Side effects:
636 *  <theAccessor> is deregistered and removed from the object accessor hash
637 *
638 * --Version--Author------------------Changes-------------------------------
639 *    1.0     jguyer@his.com original
640 * -------------------------------------------------------------------------
641 */
642int
643Tclae_RemoveObjectAccessorCmd(ClientData clientData,
644                              Tcl_Interp *interp,
645                              int objc,
646                              Tcl_Obj *const objv[])
647{
648	DescType				desiredClass;
649	DescType				containerType;
650	Tcl_HashEntry			*hashEntryPtr;	/* for entry in coercion handler hash table */
651    OSErr					err;
652
653	if (objc != 4) {
654		Tcl_WrongNumArgs(interp, 1, objv, "<desiredClass> <containerType> <theAccessor>");
655		return TCL_ERROR;
656	}
657
658	desiredClass = TclaeGetOSTypeFromObj(objv[1]);
659	containerType = TclaeGetOSTypeFromObj(objv[2]);
660
661	hashEntryPtr = TclaeGetObjectAccessor(interp,
662                                          desiredClass,
663                                          containerType,
664                                          Tcl_GetString(objv[3]));
665
666	if (hashEntryPtr == NULL) {
667		err = errAEAccessorNotFound;
668	} else {
669		err = TclaeRemoveObjectAccessor(desiredClass,
670                                        containerType,
671                                        hashEntryPtr);
672	}
673
674	if (err != noErr) {
675		Tcl_ResetResult(interp);
676		Tcl_AppendResult(interp, "Couldn't remove coercion handler: ",
677						 Tcl_MacOSError(interp, err),
678						 (char *) NULL);
679		return TCL_ERROR;
680	} else {
681		return TCL_OK;
682	}
683}
684
685/*
686 * -------------------------------------------------------------------------
687 *
688 * "Tclae_DisposeTokenCmd" --
689 *
690 *  Tcl wrapper for ToolBox AEDisposeToken call
691 *
692 *  tclAE::disposeToken <theToken>
693 *
694 * Argument     Default In/Out Description
695 * ------------ ------- ------ ---------------------------------------------
696 *  clientData					(unused)
697 *  interp				In		for results
698 *  objc				In		number of arguments
699 *  objv				In		argument objects
700 *
701 * Results:
702 *  Tcl result code
703 *
704 * Side effects:
705 *  Token is deleted
706 * -------------------------------------------------------------------------
707 */
708int
709Tclae_DisposeTokenCmd(ClientData clientData,
710                      Tcl_Interp *interp,
711                      int objc,
712                      Tcl_Obj *const objv[])
713{
714	AEDesc *	tokenPtr;
715	int			result;
716
717	if (objc != 2) {
718		Tcl_WrongNumArgs(interp, 1, objv, "<theToken>");
719		return TCL_ERROR;
720	}
721
722	/* Obtain AEDesc pointer from reference and dispose of it */
723	result = Tclae_GetAEDescFromObj(interp, objv[1], &tokenPtr, true);
724	if (result != TCL_OK) {
725		return TCL_ERROR;
726	}
727
728	if (tokenPtr) {
729		OSErr			err;	/* result from ToolBox calls */
730
731		err = AEDisposeToken(tokenPtr);
732		/* !!! what if this wasn't ckalloc'ed?
733		 * shouldn't ever happen
734		 */
735		ckfree((char *)tokenPtr);
736		if (err != noErr) {
737			Tcl_ResetResult(interp);
738			Tcl_AppendResult(interp, "Couldn't dispose of \"",
739							 Tcl_GetString(objv[1]), "\": ",
740							 Tcl_MacOSError(interp, err),
741							 (char *) NULL);
742			return TCL_ERROR;
743		}
744	} else {
745		/*
746		 * No such hash entry.
747		 * Throw a slightly bogus "descriptor not found" error
748		 */
749
750		Tcl_ResetResult(interp);
751		Tcl_AppendResult(interp, "Couldn't dispose of \"",
752						 Tcl_GetString(objv[1]), "\": ",
753						 Tcl_MacOSError(interp, errAEDescNotFound),
754						 (char *) NULL);
755		return TCL_ERROR;
756    }
757
758    return TCL_OK;
759}
760
761/* ���� Object callbacks ���� */
762
763/*
764 * -------------------------------------------------------------------------
765 *
766 * "TclaeObjectAccessor" --
767 *
768 *  AEM callback routine for all coercions to be handled by Tcl procs
769 *
770 * Results:
771 *  MacOS error code
772 *
773 * Side effects:
774 *  ???
775 *
776 * --Version--Author------------------Changes-------------------------------
777 *    1.0     jguyer@his.com original
778 * -------------------------------------------------------------------------
779 */
780static pascal OSErr
781TclaeObjectAccessor(DescType		desiredClass,
782					const AEDesc *	containerToken,
783					DescType		containerClass,
784					DescType		keyForm,
785					const AEDesc *	keyData,
786					AEDesc *		theToken,
787					long			theRefcon)
788{
789	enum {
790		kAccessorProc = 0,
791		kDesiredClass,
792		kContainerToken,
793		kContainerClass,
794		kKeyForm,
795		kKeyData,
796		kTheToken,
797		kTotalArguments
798	};
799	Tcl_Obj *				objv[kTotalArguments];
800
801	Tcl_HashEntry *			hashEntryPtr;
802	tclAEObjectAccessor *	accessorPtr;
803	int						result;
804	Tcl_CmdInfo				cmdInfo;
805
806	// theRefcon holds the hash key for this object accessor
807	hashEntryPtr = Tcl_FindHashEntry(tclAEObjectAccessorHashTable, (char *) theRefcon);
808
809	if (hashEntryPtr == NULL) {
810        // This really shouldn't happen
811		return errAEAccessorNotFound;
812	}
813
814	accessorPtr = (tclAEObjectAccessor *) Tcl_GetHashValue(hashEntryPtr);
815
816	// Apparent bug in Tcl_EvalObjv.
817	// If <accessorProc> is undefined in interp, we crash with
818	// an unmapped memory exception, instead of getting an interpreter error
819	//    invalid command name "<accessorProc>"
820	result = Tcl_GetCommandInfo(accessorPtr->interp,
821								Tcl_GetString(accessorPtr->accessorProc),
822								&cmdInfo);
823	if (!result) {
824		Tcl_ResetResult(accessorPtr->interp);
825		Tcl_AppendResult(accessorPtr->interp,
826						 "Couldn't find object accessor \"",
827						 Tcl_GetString(accessorPtr->accessorProc), "\": ",
828						 Tcl_MacOSError(accessorPtr->interp, errAEAccessorNotFound),
829						 (char *) NULL);
830		return errAEAccessorNotFound;
831	}
832
833    // Build up Tcl object accessor command
834	objv[kAccessorProc] = accessorPtr->accessorProc;
835    // Ensure none of the command objects is disposed of by the interpreter
836    Tcl_IncrRefCount(objv[kAccessorProc]);
837
838    objv[kDesiredClass] = TclaeNewOSTypeObj(desiredClass);
839    objv[kContainerToken] = Tclae_NewConstAEDescRefObj(containerToken);
840    objv[kContainerClass] = TclaeNewOSTypeObj(containerClass);
841    objv[kKeyForm] = TclaeNewOSTypeObj(keyForm);
842    objv[kKeyData] = Tclae_NewConstAEDescRefObj(keyData);
843
844    objv[kTheToken] = Tclae_NewAEDescObj(theToken);
845    Tcl_IncrRefCount(objv[kTheToken]);
846
847    // Execute the coercion handler command
848    // [<accessorProc> <desiredClass> <containerToken> <containerClass> <keyForm> <keyData> <theToken>]
849	result = Tcl_EvalObjv(accessorPtr->interp, kTotalArguments, objv, TCL_EVAL_GLOBAL);
850
851    // Decrement, but don't delete, the handler command
852    Tcl_DecrRefCount(objv[kAccessorProc]);
853
854	// Delete the reference but not the actual AEDesc (that would be Bad�)
855	// Can't just decrement, as that will delete the non-const token
856	TclaeDetachAEDescObj(objv[kTheToken]);
857    Tcl_DecrRefCount(objv[kTheToken]);
858
859	if (result != TCL_OK) {
860        OSErr	err = TclaeErrorCodeFromInterp(accessorPtr->interp);
861
862        if (err != noErr) {
863			return err;
864	    } else {
865			return errAECoercionFail;
866		}
867	} else {
868		return noErr;
869	}
870}
871
872/*
873 * -------------------------------------------------------------------------
874 *
875 * "TclaeCountObjects" --
876 *
877 *
878 *
879 * Argument     Default In/Out Description
880 * ------------ ------- ------ ---------------------------------------------
881 *  desiredClass		In
882 *  containerClass		In
883 *  theContainer		In
884 *  countPtr			Out
885 *
886 * Results:
887 *
888 *
889 * Side effects:
890 *
891 * -------------------------------------------------------------------------
892 */
893static pascal OSErr
894TclaeCountObjects(DescType desiredClass,
895                  DescType containerClass,
896                  const AEDesc *theContainer,
897                  long *countPtr)
898{
899	enum {
900		kCountProc = 0,
901		kDesiredClass,
902		kContainerClass,
903		kContainer,
904		kTotalArguments
905	};
906	Tcl_Obj *	objv[kTotalArguments];
907
908	OSErr	err = noErr;
909	int		result;
910
911
912	objv[kCountProc] = Tcl_GetVar2Ex(gInterp, "tclAE::_callbacks", "countObjects", TCL_GLOBAL_ONLY);
913	if (!objv[kCountProc]) {
914		return errAEEventNotHandled;
915	}
916    Tcl_IncrRefCount(objv[kCountProc]);
917
918	objv[kDesiredClass] = TclaeNewOSTypeObj(desiredClass);
919	objv[kContainerClass] = TclaeNewOSTypeObj(containerClass);
920    objv[kContainer] = Tclae_NewConstAEDescRefObj(theContainer);
921
922    // Execute the object count command
923    // set count [<countProc> <desiredClass> <containerClass> <container>]
924	result = Tcl_EvalObjv(gInterp, kTotalArguments, objv, TCL_EVAL_GLOBAL);
925
926	if (result != TCL_OK) {
927        err = TclaeErrorCodeFromInterp(gInterp);
928
929        if (err == noErr) {
930			err = errAEEventNotHandled;
931		}
932	} else {
933		result = Tcl_GetLongFromObj(gInterp, Tcl_GetObjResult(gInterp), countPtr);
934
935		if (result != TCL_OK) {
936			err = errAEEventNotHandled;
937		}
938	}
939
940	return err;
941}
942
943/*
944 * -------------------------------------------------------------------------
945 *
946 * "TclaeCompareObjects" --
947 *
948 *
949 *
950 * Argument     Default In/Out Description
951 * ------------ ------- ------ ---------------------------------------------
952 *
953 * Results:
954 *
955 *
956 * Side effects:
957 *
958 * -------------------------------------------------------------------------
959 */
960static pascal OSErr
961TclaeCompareObjects(DescType comparisonOperator,
962                    const AEDesc *theObject,
963                    const AEDesc *objectOrDescToCompare,
964                    Boolean *comparisonPtr)
965{
966	enum {
967		kCompareProc = 0,
968		kComparisonOperator,
969		kObject,
970		kObjectOrDescToCompare,
971		kTotalArguments
972	};
973	Tcl_Obj *	objv[kTotalArguments];
974
975	OSErr	err = noErr;
976	int		result;
977
978
979	objv[kCompareProc] = Tcl_GetVar2Ex(gInterp, "tclAE::_callbacks", "compareObjects", TCL_GLOBAL_ONLY);
980	if (!objv[kCompareProc]) {
981		return errAEEventNotHandled;
982	}
983    Tcl_IncrRefCount(objv[kCompareProc]);
984
985	objv[kComparisonOperator] = TclaeNewOSTypeObj(comparisonOperator);
986    objv[kObject] = Tclae_NewConstAEDescRefObj(theObject);
987    objv[kObjectOrDescToCompare] = Tclae_NewConstAEDescRefObj(objectOrDescToCompare);
988
989    // Execute the object comparison command
990    // set comparison [<compareProc> <comparisonOperator> <theObject> <objectOrDescToCompare>]
991	result = Tcl_EvalObjv(gInterp, kTotalArguments, objv, TCL_EVAL_GLOBAL);
992
993	if (result != TCL_OK) {
994        err = TclaeErrorCodeFromInterp(gInterp);
995
996        if (err == noErr) {
997			err = errAEEventNotHandled;
998		}
999	} else {
1000		int	temp;
1001
1002		result = Tcl_GetBooleanFromObj(gInterp, Tcl_GetObjResult(gInterp), &temp);
1003		*comparisonPtr = temp;
1004
1005		if (result != TCL_OK) {
1006			err = errAEEventNotHandled;
1007		}
1008	}
1009
1010	return err;
1011}
1012
1013/*
1014 * -------------------------------------------------------------------------
1015 *
1016 * "TclaeDisposeToken" --
1017 *
1018 *
1019 *
1020 * Argument     Default In/Out Description
1021 * ------------ ------- ------ ---------------------------------------------
1022 *
1023 * Results:
1024 *
1025 *
1026 * Side effects:
1027 *
1028 * -------------------------------------------------------------------------
1029 */
1030static pascal OSErr
1031TclaeDisposeToken(AEDesc *unneededToken)
1032{
1033	enum {
1034		kDisposeProc = 0,
1035		kUnneededToken,
1036		kTotalArguments
1037	};
1038	Tcl_Obj *	objv[kTotalArguments];
1039
1040	OSErr	err = noErr;
1041	int		result;
1042
1043
1044	objv[kDisposeProc] = Tcl_GetVar2Ex(gInterp, "tclAE::_callbacks", "disposeToken", TCL_GLOBAL_ONLY);
1045	if (!objv[kDisposeProc]) {
1046		return errAEEventNotHandled;
1047	}
1048    Tcl_IncrRefCount(objv[kDisposeProc]);
1049
1050    objv[kUnneededToken] = Tclae_NewAEDescRefObj(unneededToken);
1051    Tcl_IncrRefCount(objv[kUnneededToken]);
1052
1053    // Execute the token disposal command
1054    // [<disposeTokenPro> <unneededToken>]
1055	result = Tcl_EvalObjv(gInterp, kTotalArguments, objv, TCL_EVAL_GLOBAL);
1056
1057	TclaeDetachAEDescObj(objv[kUnneededToken]);
1058    Tcl_DecrRefCount(objv[kUnneededToken]);
1059
1060	if (result != TCL_OK) {
1061        err = TclaeErrorCodeFromInterp(gInterp);
1062
1063        if (err == noErr) {
1064			err = errAEEventNotHandled;
1065		}
1066	}
1067
1068	return err;
1069}
1070
1071/*
1072 * -------------------------------------------------------------------------
1073 *
1074 * "TclaeGetErrorDesc" --
1075 *
1076 *
1077 *
1078 * Argument     Default In/Out Description
1079 * ------------ ------- ------ ---------------------------------------------
1080 *
1081 * Results:
1082 *
1083 *
1084 * Side effects:
1085 *
1086 * -------------------------------------------------------------------------
1087 */
1088static pascal OSErr
1089TclaeGetErrorDesc(AEDescPtr *errDescPtr)
1090{
1091	*errDescPtr = &gErrorDesc;
1092
1093	return noErr;
1094}
1095
1096/*
1097 * -------------------------------------------------------------------------
1098 *
1099 * "TclaeGetMarkToken" --
1100 *
1101 *
1102 *
1103 * Argument     Default In/Out Description
1104 * ------------ ------- ------ ---------------------------------------------
1105 *
1106 * Results:
1107 *
1108 *
1109 * Side effects:
1110 *
1111 * -------------------------------------------------------------------------
1112 */
1113static pascal OSErr
1114TclaeGetMarkToken(const AEDesc *containerToken,
1115                  DescType containerClass,
1116                  AEDesc *resultDesc)
1117{
1118	enum {
1119		kGetMarkTokenProc = 0,
1120		kContainerToken,
1121		kContainerClass,
1122		kResultDesc,
1123		kTotalArguments
1124	};
1125	Tcl_Obj *	objv[kTotalArguments];
1126
1127	OSErr	err = noErr;
1128	int		result;
1129
1130
1131	objv[kGetMarkTokenProc] = Tcl_GetVar2Ex(gInterp, "tclAE::_callbacks", "getMarkToken", TCL_GLOBAL_ONLY);
1132	if (!objv[kGetMarkTokenProc]) {
1133		return errAEEventNotHandled;
1134	}
1135    Tcl_IncrRefCount(objv[kGetMarkTokenProc]);
1136
1137    objv[kContainerToken] = Tclae_NewConstAEDescRefObj(containerToken);
1138	objv[kContainerClass] = TclaeNewOSTypeObj(containerClass);
1139
1140    objv[kResultDesc] = Tclae_NewAEDescRefObj(resultDesc);
1141    Tcl_IncrRefCount(objv[kResultDesc]);
1142
1143    // Execute the get mark token command
1144    // [<getMarkTokenProc> <containerToken> <containerClass> <resultDesc>]
1145	result = Tcl_EvalObjv(gInterp, kTotalArguments, objv, TCL_EVAL_GLOBAL);
1146
1147	TclaeDetachAEDescObj(objv[kResultDesc]);
1148    Tcl_DecrRefCount(objv[kResultDesc]);
1149
1150	if (result != TCL_OK) {
1151        err = TclaeErrorCodeFromInterp(gInterp);
1152
1153        if (err == noErr) {
1154			err = errAEEventNotHandled;
1155		}
1156	}
1157
1158	return err;
1159}
1160
1161/*
1162 * -------------------------------------------------------------------------
1163 *
1164 * "TclaeMark" --
1165 *
1166 *
1167 *
1168 * Argument     Default In/Out Description
1169 * ------------ ------- ------ ---------------------------------------------
1170 *
1171 * Results:
1172 *
1173 *
1174 * Side effects:
1175 *
1176 * -------------------------------------------------------------------------
1177 */
1178static pascal OSErr
1179TclaeMark(const AEDesc *theToken,
1180          const AEDesc *markToken,
1181          long markCount)
1182{
1183	enum {
1184		kMarkProc = 0,
1185		kTheToken,
1186		kMarkToken,
1187		kMarkCount,
1188		kTotalArguments
1189	};
1190	Tcl_Obj *	objv[kTotalArguments];
1191
1192	OSErr	err = noErr;
1193	int		result;
1194
1195
1196	objv[kMarkProc] = Tcl_GetVar2Ex(gInterp, "tclAE::_callbacks", "mark", TCL_GLOBAL_ONLY);
1197	if (!objv[kMarkProc]) {
1198		return errAEEventNotHandled;
1199	}
1200    Tcl_IncrRefCount(objv[kMarkProc]);
1201
1202    objv[kTheToken] = Tclae_NewConstAEDescRefObj(theToken);
1203    objv[kMarkToken] = Tclae_NewConstAEDescRefObj(markToken);
1204    objv[kMarkCount] = Tcl_NewLongObj(markCount);
1205
1206    // Execute the mark command
1207    // [<markProc> <theToken> <markToken> <markCount>]
1208	result = Tcl_EvalObjv(gInterp, kTotalArguments, objv, TCL_EVAL_GLOBAL);
1209
1210	if (result != TCL_OK) {
1211        err = TclaeErrorCodeFromInterp(gInterp);
1212
1213        if (err == noErr) {
1214			err = errAEEventNotHandled;
1215		}
1216	}
1217
1218	return err;
1219}
1220
1221/*
1222 * -------------------------------------------------------------------------
1223 *
1224 * "TclaeAdjustMarks" --
1225 *
1226 *
1227 *
1228 * Argument     Default In/Out Description
1229 * ------------ ------- ------ ---------------------------------------------
1230 *
1231 * Results:
1232 *  �
1233 *
1234 * Side effects:
1235 *  �
1236 * -------------------------------------------------------------------------
1237 */
1238static pascal OSErr
1239TclaeAdjustMarks(long newStart,
1240                 long newStop,
1241                 const AEDesc *markToken)
1242{
1243	enum {
1244		kAdjustMarksProc = 0,
1245		kNewStart,
1246		kNewStop,
1247		kMarkToken,
1248		kTotalArguments
1249	};
1250	Tcl_Obj *	objv[kTotalArguments];
1251
1252	OSErr	err = noErr;
1253	int		result;
1254
1255
1256	objv[kAdjustMarksProc] = Tcl_GetVar2Ex(gInterp, "tclAE::_callbacks", "adjustMarks", TCL_GLOBAL_ONLY);
1257	if (!objv[kAdjustMarksProc]) {
1258		return errAEEventNotHandled;
1259	}
1260    Tcl_IncrRefCount(objv[kAdjustMarksProc]);
1261
1262    objv[kNewStart] = Tcl_NewLongObj(newStart);
1263    objv[kNewStop] = Tcl_NewLongObj(newStop);
1264    objv[kMarkToken] = Tclae_NewConstAEDescRefObj(markToken);
1265
1266    // Execute the adjust marks command
1267    // [<adjustMarksProc> <newStart> <newStop> <markToken>]
1268	result = Tcl_EvalObjv(gInterp, kTotalArguments, objv, TCL_EVAL_GLOBAL);
1269
1270	if (result != TCL_OK) {
1271        err = TclaeErrorCodeFromInterp(gInterp);
1272
1273        if (err == noErr) {
1274			err = errAEEventNotHandled;
1275		}
1276	}
1277
1278	return err;
1279}
1280
1281/* ���� Internal routines ���� */
1282
1283/*
1284 * -------------------------------------------------------------------------
1285 *
1286 * "TclaeGetObjectAccessor" --
1287 *
1288 *  Find specified entry in hash table for object accessors
1289 *  If accessorProc is not NULL, it must match
1290 *
1291 * Results:
1292 *  Tcl_HashEntry pointer (or NULL) for desired accessor
1293 *
1294 * Side effects:
1295 *  None.
1296 * -------------------------------------------------------------------------
1297 */
1298static Tcl_HashEntry*
1299TclaeGetObjectAccessor(Tcl_Interp*	interp,
1300                       DescType		desiredClass,
1301                       DescType		containerType,
1302                       char*		accessorProc)
1303{
1304	Tcl_HashEntry			*hashEntryPtr;		/* for search of AEObjectAccessor */
1305    Tcl_HashSearch			search;				/*    hash list                    */
1306	tclAEObjectAccessor		*objectAccessorPtr;
1307
1308    // Search through coercion handler hash table for this type pair
1309    for (hashEntryPtr = Tcl_FirstHashEntry(tclAEObjectAccessorHashTable, &search);
1310		 hashEntryPtr != NULL;
1311		 hashEntryPtr = Tcl_NextHashEntry(&search)) {
1312
1313		objectAccessorPtr = Tcl_GetHashValue(hashEntryPtr);
1314		if ((objectAccessorPtr->desiredClass == desiredClass)
1315		&&  (objectAccessorPtr->containerType == containerType)
1316		&&  (objectAccessorPtr->interp == interp)) {
1317			if (accessorProc
1318			&&	(strcmp(accessorProc,
1319						Tcl_GetString(objectAccessorPtr->accessorProc)) != 0)) {
1320				// accessorProc doesn't match
1321				continue;
1322			} else {
1323	        	// found
1324				break;
1325			}
1326		}
1327    }
1328
1329    return hashEntryPtr;
1330}
1331
1332/*
1333 * -------------------------------------------------------------------------
1334 *
1335 * "TclaeInitObjectAccessors" --
1336 *
1337 *  Initialize object accessors.
1338 *
1339 * Results:
1340 *  None.
1341 *
1342 * Side effects:
1343 *  Object accessors activated.
1344 * -------------------------------------------------------------------------
1345 */
1346void
1347TclaeInitObjectAccessors(Tcl_Interp *interp)
1348{
1349	/* Store identifier for the global error descriptor */
1350        Tcl_Obj *	newObj = Tclae_NewAEDescRefObj(&gErrorDesc);
1351        Tcl_IncrRefCount(newObj);
1352        Tcl_SetVar2Ex(interp, "tclAE::errorDesc", NULL, newObj, TCL_GLOBAL_ONLY);
1353
1354	/* Initialize the AE Handler hash table */
1355	tclAEObjectAccessorHashTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
1356	if (tclAEObjectAccessorHashTable) {
1357		Tcl_InitHashTable(tclAEObjectAccessorHashTable, TCL_ONE_WORD_KEYS);
1358	} else {
1359		Tcl_ResetResult(interp);
1360		Tcl_AppendResult(interp, "Couldn't initialize object accessors",
1361						 (char *) NULL);
1362	}
1363}
1364
1365/*
1366 * -------------------------------------------------------------------------
1367 *
1368 * "TclaeRemoveObjectAccessor" --
1369 *
1370 *  Remove entry from hash table for object accessors, and deregister
1371 *  accessor with the AEM
1372 *
1373 * Results:
1374 *  OS Error
1375 *
1376 * Side effects:
1377 *  Specified accessor is removed
1378 * -------------------------------------------------------------------------
1379 */
1380static OSErr
1381TclaeRemoveObjectAccessor(
1382	DescType				desiredClass,
1383	DescType				containerType,
1384	Tcl_HashEntry *			hashEntryPtr)
1385{
1386	tclAEObjectAccessor*	accessorPtr = Tcl_GetHashValue(hashEntryPtr);
1387
1388    // Delete the object holding the accessor proc
1389	Tcl_DecrRefCount(accessorPtr->accessorProc);
1390	// Remove the coercion hash entry
1391	Tcl_DeleteHashEntry(hashEntryPtr);
1392	// Delete the coercion handler structure
1393	ckfree((char*) accessorPtr);
1394
1395    // Deregister any accessor for this type-pair with the AEM
1396	return AERemoveObjectAccessor(desiredClass,
1397								  containerType,
1398								  TclaeObjectAccessorUPP,
1399                            	  false);
1400}
1401