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