1/* -*- mode: C; coding: macintosh; -*- 2 * ################################################################### 3 * TclAE - AppleEvent extension for Tcl 4 * 5 * FILE: "tclAEHandler.c" 6 * created: 5/6/2000 {11:34:24 PM} 7 * last update: 8/1/10 {12:06:38 PM} 8 * Author: Tim Endres 9 * Author: Pete Keleher 10 * Author: Jon Guyer 11 * E-mail: jguyer@his.com 12 * mail: Alpha Cabal 13 * www: http://www.his.com/jguyer/ 14 * 15 * ======================================================================== 16 * Copyright (c) 1992 Tim Endres 17 * Copyright (c) 1990-1998 Pete Keleher 18 * Copyright (c) 1999-2003 Jonathan Guyer 19 * All rights reserved 20 * ======================================================================== 21 * Permission to use, copy, modify, and distribute this software and its 22 * documentation for any purpose and without fee is hereby granted, 23 * provided that the above copyright notice appear in all copies and that 24 * both that the copyright notice and warranty disclaimer appear in 25 * supporting documentation. 26 * 27 * The Authors disclaim all warranties with regard to this software, 28 * including all implied warranties of merchantability and fitness. In 29 * no event shall the Authors be liable for any special, indirect or 30 * consequential damages or any damages whatsoever resulting from loss of 31 * use, data or profits, whether in an action of contract, negligence or 32 * other tortuous action, arising out of or in connection with the use or 33 * performance of this software. 34 # ======================================================================== 35 # Description: 36 # 37 # History 38 # 39 * modified by rev reason 40 * ---------- --- --- ----------- 41 * 1992? TE? 1.0 original 42 * 2000-05-06 JEG 2.0 using tclAE descriptors 43 * ======================================================================== 44 * See header file for further information 45 * ################################################################### 46 */ 47 48#ifdef TCLAE_USE_FRAMEWORK_INCLUDES 49#include <Carbon/Carbon.h> 50#else 51#include <Aliases.h> 52#include <AppleEvents.h> 53#include <TextUtils.h> 54#endif 55 56#include <string.h> 57 58#ifdef MAC_TCL 59#include <tclMacInt.h> 60#elif TARGET_RT_MAC_MACHO 61#include "osxMacTcl.h" 62#endif 63 64#include "tclAEInt.h" 65#include "tclMacOSError.h" 66 67/* Hash table for storage of AppleEvent handlers */ 68static Tcl_HashTable *tclAEEventHandlerHashTable; 69 70/* Hash table for storage of coercion handlers */ 71static Tcl_HashTable *tclAECoercionHandlerHashTable; 72 73extern AEReturnID gReturnID; 74 75typedef struct tclAEEventHandler { 76 OSType eventClass; 77 OSType eventID; 78 Tcl_Obj *eventHandlerProc; 79 Tcl_Interp *interp; 80} tclAEEventHandler; 81 82typedef struct tclAECoercionHandler { 83 OSType fromType; 84 OSType toType; 85 Tcl_Obj *coercionHandlerProc; 86 Tcl_Interp *interp; 87} tclAECoercionHandler; 88 89static AEEventHandlerUPP TclaeEventHandlerUPP; 90static AEEventHandlerUPP TclaeReplyHandlerUPP; 91 92static pascal OSErr TclaeEventHandler(const AppleEvent *theAppleEvent, AppleEvent *reply, long handlerRefcon); 93static pascal OSErr TclaeReplyHandler(const AppleEvent *theAppleEvent, AppleEvent *reply, long handlerRefcon); 94static OSErr TclaeDispatchEvent(const AppleEvent *theAppleEvent, AppleEvent *reply, tclAEEventHandler *eventHandlerPtr); 95 96static AECoercePtrUPP TclaeCoercionHandlerUPP; 97 98static AECoercePtrUPP Tclaealis2TEXTHandlerUPP; 99static AECoercePtrUPP TclaeTEXT2alisHandlerUPP; 100static AECoercePtrUPP Tclaefsrf2TEXTHandlerUPP; 101static AECoercePtrUPP TclaeTEXT2fsrfHandlerUPP; 102#if !__LP64__ 103static AECoercePtrUPP Tclaefss_2TEXTHandlerUPP; 104static AECoercePtrUPP TclaeTEXT2fss_HandlerUPP; 105#endif // !__LP64__ 106static AECoercePtrUPP TclaeWILD2TEXTHandlerUPP; 107 108static pascal OSErr Tclaealis2TEXTHandler(DescType dataType, const void *dataPtr, Size dataSize, DescType toType, long refCon, AEDesc *resultDesc); 109static pascal OSErr Tclaefsrf2TEXTHandler(DescType dataType, const void *dataPtr, Size dataSize, DescType toType, long refCon, AEDesc *resultDesc); 110static pascal OSErr TclaeTEXT2alisHandler(DescType dataType, const void *dataPtr, Size dataSize, DescType toType, long refCon, AEDesc *resultDesc); 111#if !__LP64__ 112static pascal OSErr Tclaefss_2TEXTHandler(DescType dataType, const void *dataPtr, Size dataSize, DescType toType, long refCon, AEDesc *resultDesc); 113static pascal OSErr TclaeTEXT2fss_Handler(DescType dataType, const void *dataPtr, Size dataSize, DescType toType, long refCon, AEDesc *resultDesc); 114#endif // !__LP64__ 115static pascal OSErr TclaeWILD2TEXTHandler(DescType dataType, const void *dataPtr, Size dataSize, DescType toType, long refCon, AEDesc *resultDesc); 116 117 118static pascal OSErr TclaeCoercionHandler(DescType typeCode, const void *dataPtr, Size dataSize, DescType toType, long handlerRefcon, AEDesc *resultDesc); 119 120static Tcl_HashEntry* TclaeGetCoercionHandler(Tcl_Interp* interp, OSType fromType, OSType toType, char* handlerProc); 121static OSErr TclaeRemoveCoercionHandler(OSType fromType, OSType toType, Tcl_HashEntry* hashEntryPtr); 122 123static Tcl_HashEntry* TclaeGetEventHandler(Tcl_Interp* interp, OSType eventClass, OSType eventID, char* handlerProc); 124static OSErr TclaeRemoveEventHandler(OSType eventClass, OSType eventID, Tcl_HashEntry* hashEntryPtr); 125 126#if TARGET_API_MAC_CARBON 127static int TclaeGetPathDString(Tcl_Interp *interp, Tcl_Obj *inPath, 128 Boolean isDirectory, CFURLPathStyle fromPathStyle, 129 CFURLPathStyle toPathStyle, Tcl_DString *outDS); 130#endif 131 132/* ���� Public package routines ���� */ 133 134/* 135 * ------------------------------------------------------------------------- 136 * 137 * "Tclae_InstallCoercionHandlerCmd" -- 138 * 139 * Tcl wrapper for ToolBox AEInstallCoercionHandler call. 140 * This allows Tcl procs to act as coercion handlers. 141 * 142 * tclAE::installCoercionHander <fromType> <toType> <handlerProc> 143 * 144 * Results: 145 * Tcl result code 146 * 147 * Side effects: 148 * <handlerProc> is registered and added to the coercion handler hash 149 * 150 * --Version--Author------------------Changes------------------------------- 151 * 1.0 jguyer@his.com original 152 * ------------------------------------------------------------------------- 153 */ 154int 155Tclae_InstallCoercionHandlerCmd(ClientData clientData, 156 Tcl_Interp *interp, 157 int objc, 158 Tcl_Obj *const objv[]) 159{ 160 OSType fromType; 161 OSType toType; 162 tclAECoercionHandler* coercionHandlerPtr; 163 Tcl_HashEntry* hashEntryPtr; /* for entry in coercion handler hash table */ 164 OSErr err; 165 int isNew; /* is hash already used 166 (shouldn't be!) */ 167 168 if (objc != 4) { 169 Tcl_WrongNumArgs(interp, 1, objv, "<fromType> <toType> <coercionHandlerProc>"); 170 return TCL_ERROR; 171 } 172 173 // As far as the AEM is concerned, all registered coercions are handled by 174 // TclaeCoercionHandler() 175 if (!TclaeCoercionHandlerUPP) { 176 TclaeCoercionHandlerUPP = NewAECoercePtrUPP(TclaeCoercionHandler); 177 } 178 179 fromType = TclaeGetOSTypeFromObj(objv[1]); 180 toType = TclaeGetOSTypeFromObj(objv[2]); 181 182 hashEntryPtr = TclaeGetCoercionHandler(interp, fromType, toType, NULL); 183 184 if (hashEntryPtr == NULL) { 185 // Not found. Create a new hash entry for this coercion 186 187 coercionHandlerPtr = (tclAECoercionHandler *) ckalloc(sizeof(tclAECoercionHandler)); 188 coercionHandlerPtr->fromType = fromType; 189 coercionHandlerPtr->toType = toType; 190 191 // No need to check isNew because that's the only reason we're here 192 hashEntryPtr = Tcl_CreateHashEntry(tclAECoercionHandlerHashTable, 193 (char *) coercionHandlerPtr, 194 &isNew); 195 if (isNew) { 196 // Set hash entry to point at the coercion handler record 197 Tcl_SetHashValue(hashEntryPtr, coercionHandlerPtr); 198 } 199 } else { 200 // Found. Get the existing handler from the hash entry. 201 coercionHandlerPtr = (tclAECoercionHandler *) Tcl_GetHashValue(hashEntryPtr); 202 } 203 204 // Assign the Tcl proc which is to handle this coercion 205 coercionHandlerPtr->interp = interp; 206 coercionHandlerPtr->coercionHandlerProc = objv[3]; 207 // Keep proc from being deleted by the interpreter 208 Tcl_IncrRefCount(objv[3]); 209 210 // Register this coercion with the AEM 211 err = AEInstallCoercionHandler(fromType, 212 toType, 213 (AECoercionHandlerUPP)TclaeCoercionHandlerUPP, 214 (SRefCon) coercionHandlerPtr, 215 false, false); 216 if (err != noErr) { 217 Tcl_ResetResult(interp); 218 Tcl_AppendResult(interp, "Couldn't install coercion handler: ", 219 Tcl_MacOSError(interp, err), 220 (char *) NULL); 221 return TCL_ERROR; 222 } else { 223 return TCL_OK; 224 } 225} 226 227/* 228 * ------------------------------------------------------------------------- 229 * 230 * "Tclae_RemoveCoercionHandlerCmd" -- 231 * 232 * Tcl wrapper for ToolBox AERemoveCoercionHandler call. 233 * This removes a Tcl proc that has been installed as a coercion handler. 234 * 235 * tclAE::removeCoercionHander <fromType> <toType> <handlerProc> 236 * 237 * Results: 238 * Tcl result code 239 * 240 * Side effects: 241 * <handlerProc> is deregistered and removed from the coercion handler hash 242 * 243 * --Version--Author------------------Changes------------------------------- 244 * 1.0 jguyer@his.com original 245 * ------------------------------------------------------------------------- 246 */ 247int 248Tclae_RemoveCoercionHandlerCmd(ClientData clientData, 249 Tcl_Interp *interp, 250 int objc, 251 Tcl_Obj *const objv[]) 252{ 253 OSType fromType; 254 OSType toType; 255 Tcl_HashEntry *hashEntryPtr; /* for entry in coercion handler hash table */ 256 OSErr err; 257 258 if (objc != 4) { 259 Tcl_WrongNumArgs(interp, 1, objv, "<fromType> <toType> <coercionHandlerProc>"); 260 return TCL_ERROR; 261 } 262 263 fromType = TclaeGetOSTypeFromObj(objv[1]); 264 toType = TclaeGetOSTypeFromObj(objv[2]); 265 266 hashEntryPtr = TclaeGetCoercionHandler(interp, fromType, toType, Tcl_GetString(objv[3])); 267 268 if (hashEntryPtr == NULL) { 269 err = -1717; // No coercion handler found 270 } else { 271 err = TclaeRemoveCoercionHandler(fromType, toType, hashEntryPtr); 272 } 273 274 if (err != noErr) { 275 Tcl_ResetResult(interp); 276 Tcl_AppendResult(interp, "Couldn't remove coercion handler: ", 277 Tcl_MacOSError(interp, err), 278 (char *) NULL); 279 return TCL_ERROR; 280 } else { 281 return TCL_OK; 282 } 283} 284 285/* 286 * ------------------------------------------------------------------------- 287 * 288 * "Tclae_GetCoercionHandlerCmd" -- 289 * 290 * Tcl wrapper for ToolBox AEGetCoercionHandler call. 291 * This returns the Tcl proc that has been installed as a coercion handler. 292 * 293 * tclAE::getCoercionHander <fromType> <toType> 294 * 295 * Results: 296 * Tcl result code 297 * 298 * Side effects: 299 * result of interp is set to registered <handlerProc> 300 * or OSErr -1717 if none 301 * 302 * --Version--Author------------------Changes------------------------------- 303 * 1.0 jguyer@his.com original 304 * ------------------------------------------------------------------------- 305 */ 306int 307Tclae_GetCoercionHandlerCmd(ClientData clientData, 308 Tcl_Interp *interp, 309 int objc, 310 Tcl_Obj *const objv[]) 311{ 312 OSType fromType; 313 OSType toType; 314 Tcl_HashEntry* hashEntryPtr; /* for entry in coercion handler hash table */ 315 OSErr err; 316 317 AECoercionHandlerUPP handler; 318 long handlerRefcon; 319 Boolean fromTypeIsDesc; 320 321 if (objc != 3) { 322 Tcl_WrongNumArgs(interp, 1, objv, "<fromType> <toType>"); 323 return TCL_ERROR; 324 } 325 326 fromType = TclaeGetOSTypeFromObj(objv[1]); 327 toType = TclaeGetOSTypeFromObj(objv[2]); 328 329 hashEntryPtr = TclaeGetCoercionHandler(interp, fromType, toType, NULL); 330 331 if (hashEntryPtr == NULL) { 332 // Check if there's a non-Tcl coercion handler registered in 333 // the application handler table. 334 // If there is, return nothing. 335 err = AEGetCoercionHandler(fromType, 336 toType, 337 &handler, 338 (SRefCon*) &handlerRefcon, 339 &fromTypeIsDesc, 340 false); 341 if (err == errAEHandlerNotFound) { 342 // Check if there's a non-Tcl coercion handler registered in 343 // the system handler table. 344 // If there is, return nothing. 345 err = AEGetCoercionHandler(fromType, 346 toType, 347 &handler, 348 (SRefCon*) &handlerRefcon, 349 &fromTypeIsDesc, 350 true); 351 } 352 } else { 353 tclAECoercionHandler* coercionHandlerPtr = Tcl_GetHashValue(hashEntryPtr); 354 355 // Ensure this handler is actually registered with the AEM 356 err = AEGetCoercionHandler(fromType, 357 toType, 358 &handler, 359 (SRefCon*) &handlerRefcon, 360 &fromTypeIsDesc, 361 false); 362 363 if ((err != noErr) 364 || (handler != (AECoercionHandlerUPP)TclaeCoercionHandlerUPP) 365 || (handlerRefcon != (long) coercionHandlerPtr) 366 || fromTypeIsDesc) { 367 // Something is severely wrong. 368 // The handler in the coercion hash table is either not 369 // registered with the AEM at all, or it is inconsistent 370 // with what the AEM thinks it is. 371 372 // Delete this coercion hash entry. 373 TclaeRemoveCoercionHandler(fromType, toType, hashEntryPtr); 374 375 if (err == noErr) { 376 // The AEM didn't report an error, but something was 377 // wrong anyway. Report handler not found. 378 err = errAEHandlerNotFound; 379 } 380 } else { 381 // Return <handlerProc> 382 Tcl_Obj *handlerProcPtr = coercionHandlerPtr->coercionHandlerProc; 383 384 // Keep interpreter from deleting it 385 Tcl_IncrRefCount(handlerProcPtr); 386 387 Tcl_SetObjResult(interp, handlerProcPtr); 388 } 389 } 390 391 if (err != noErr) { 392 Tcl_ResetResult(interp); 393 Tcl_AppendResult(interp, "Couldn't find coercion handler: ", 394 Tcl_MacOSError(interp, err), 395 (char *) NULL); 396 return TCL_ERROR; 397 } else { 398 return TCL_OK; 399 } 400} 401 402/* 403 * ------------------------------------------------------------------------- 404 * 405 * "Tclae_InstallEventHandlerCmd" -- 406 * 407 * Tcl wrapper for ToolBox AEInstallEventHandler call. 408 * This allows Tcl procs to act as event handlers. 409 * 410 * tclAE::installEventHander <aeclass> <aeeventID> <eventHandlerProc> 411 * 412 * Results: 413 * Tcl result code 414 * 415 * Side effects: 416 * <handlerProc> is registered and added to the event handler hash 417 * 418 * --Version--Author------------------Changes------------------------------- 419 * 1.0 jguyer@his.com original 420 * ------------------------------------------------------------------------- 421 */ 422int 423Tclae_InstallEventHandlerCmd(ClientData clientData, 424 Tcl_Interp *interp, 425 int objc, 426 Tcl_Obj *const objv[]) 427{ 428 OSType eventClass; 429 OSType eventID; 430 tclAEEventHandler* eventHandlerPtr; 431 Tcl_HashEntry* hashEntryPtr; /* for entry in event handler hash table */ 432 OSErr err; 433 int isNew; /* is hash already used 434 (shouldn't be!) */ 435 436 if (objc < 4) { 437 Tcl_WrongNumArgs(interp, 1, objv, "<aeclass> <aeeventID> <eventHandlerProc>"); 438 return TCL_ERROR; 439 } 440 441 // As far as the AEM is concerned, all registered events are handled by 442 // TclaeEventHandler() 443 if (!TclaeEventHandlerUPP) { 444 TclaeEventHandlerUPP = NewAEEventHandlerUPP(TclaeEventHandler); 445 } 446 447 eventClass = TclaeGetOSTypeFromObj(objv[1]); 448 eventID = TclaeGetOSTypeFromObj(objv[2]); 449 450 hashEntryPtr = TclaeGetEventHandler(interp, eventClass, eventID, NULL); 451 452 if (hashEntryPtr == NULL) { 453 // Not found. Create a new hash entry for this event and ID 454 455 eventHandlerPtr = (tclAEEventHandler *) ckalloc(sizeof(tclAEEventHandler)); 456 eventHandlerPtr->eventClass = eventClass; 457 eventHandlerPtr->eventID = eventID; 458 459 // No need to check isNew because that's the only reason we're here 460 hashEntryPtr = Tcl_CreateHashEntry(tclAEEventHandlerHashTable, 461 (char *) eventHandlerPtr, 462 &isNew); 463 464 if (isNew) { 465 // Set hash entry to point at the event handler record 466 Tcl_SetHashValue(hashEntryPtr, eventHandlerPtr); 467 } 468 } else { 469 // Found. Get the existing handler from the hash entry. 470 eventHandlerPtr = (tclAEEventHandler *) Tcl_GetHashValue(hashEntryPtr); 471 } 472 473 // Assign the Tcl proc which is to handle this event 474 eventHandlerPtr->interp = interp; 475 eventHandlerPtr->eventHandlerProc = objv[3]; 476 // Keep proc from being deleted by the interpreter 477 Tcl_IncrRefCount(objv[3]); 478 479 // Register this event with the AEM 480 err = AEInstallEventHandler(eventClass, 481 eventID, 482 TclaeEventHandlerUPP, 483 (SRefCon) eventHandlerPtr, 484 false); 485 if (err != noErr) { 486 Tcl_ResetResult(interp); 487 Tcl_AppendResult(interp, "Couldn't install event handler: ", 488 Tcl_MacOSError(interp, err), 489 (char *) NULL); 490 return TCL_ERROR; 491 } 492 493 return TCL_OK; 494} 495 496/* 497 * ------------------------------------------------------------------------- 498 * 499 * "Tclae_RemoveEventHandlerCmd" -- 500 * 501 * Tcl wrapper for ToolBox AERemoveEventHandler call. 502 * This removes a Tcl proc that has been installed as an event handler. 503 * 504 * tclAE::removeEventHander <AEClass> <AEEventID> <handlerProc> 505 * 506 * Results: 507 * Tcl result code 508 * 509 * Side effects: 510 * <handlerProc> is deregistered and removed from the event handler hash 511 * 512 * --Version--Author------------------Changes------------------------------- 513 * 1.0 jguyer@his.com original 514 * ------------------------------------------------------------------------- 515 */ 516int 517Tclae_RemoveEventHandlerCmd(ClientData clientData, 518 Tcl_Interp *interp, 519 int objc, 520 Tcl_Obj *const objv[]) 521{ 522 OSType eventClass; 523 OSType eventID; 524 Tcl_HashEntry* hashEntryPtr; /* for entry in event handler hash table */ 525 OSErr err; 526 527 if (objc != 4) { 528 Tcl_WrongNumArgs(interp, 1, objv, "<aeclass> <aeeventID> <eventHandlerProc>"); 529 return TCL_ERROR; 530 } 531 532 // As far as the AEM is concerned, all registered events are handled by 533 // TclaeEventHandler() 534 if (!TclaeEventHandlerUPP) { 535 TclaeEventHandlerUPP = NewAEEventHandlerUPP(TclaeEventHandler); 536 } 537 538 eventClass = TclaeGetOSTypeFromObj(objv[1]); 539 eventID = TclaeGetOSTypeFromObj(objv[2]); 540 541 hashEntryPtr = TclaeGetEventHandler(interp, eventClass, eventID, Tcl_GetString(objv[3])); 542 543 if (hashEntryPtr == NULL) { 544 err = errAEHandlerNotFound; // No event handler found 545 } else { 546 err = TclaeRemoveEventHandler(eventClass, eventID, hashEntryPtr); 547 } 548 549 if (err != noErr) { 550 Tcl_ResetResult(interp); 551 Tcl_AppendResult(interp, "Couldn't remove event handler: ", 552 Tcl_MacOSError(interp, err), 553 (char *) NULL); 554 return TCL_ERROR; 555 } 556 557 return TCL_OK; 558} 559 560/* 561 * ------------------------------------------------------------------------- 562 * 563 * "Tclae_GetEventHandlerCmd" -- 564 * 565 * Tcl wrapper for ToolBox AEGetEventHandler call. 566 * This returns the Tcl proc that has been installed as an event handler. 567 * 568 * tclAE::getEventHander <aeclass> <aeeventID> 569 * 570 * Results: 571 * Tcl result code 572 * 573 * Side effects: 574 * result of interp is set to registered <handlerProc> 575 * or errAEHandlerNotFound if none 576 * 577 * --Version--Author------------------Changes------------------------------- 578 * 1.0 jguyer@his.com original 579 * ------------------------------------------------------------------------- 580 */ 581int 582Tclae_GetEventHandlerCmd(ClientData clientData, 583 Tcl_Interp *interp, 584 int objc, 585 Tcl_Obj *const objv[]) 586{ 587 OSType eventClass; 588 OSType eventID; 589 Tcl_HashEntry *hashEntryPtr; /* for entry in event handler hash table */ 590 OSErr err; 591 592 AEEventHandlerUPP handler; 593 long handlerRefcon; 594 595 if (objc != 3) { 596 Tcl_WrongNumArgs(interp, 1, objv, "<aeclass> <aeeventID>"); 597 return TCL_ERROR; 598 } 599 600 eventClass = TclaeGetOSTypeFromObj(objv[1]); 601 eventID = TclaeGetOSTypeFromObj(objv[2]); 602 603 hashEntryPtr = TclaeGetEventHandler(interp, eventClass, eventID, NULL); 604 605 if (hashEntryPtr == NULL) { 606 // Check if there's a non-Tcl event handler registered in 607 // the application handler table. 608 // If there is, return nothing. 609 err = AEGetEventHandler(eventClass, 610 eventID, 611 &handler, 612 (SRefCon *) &handlerRefcon, 613 false); 614 if (err != errAEHandlerNotFound) { 615 // Check if there's a non-Tcl event handler registered in 616 // the system handler table. 617 // If there is, return nothing. 618 err = AEGetEventHandler(eventClass, 619 eventID, 620 &handler, 621 (SRefCon *) &handlerRefcon, 622 true); 623 } 624 } else { 625 tclAEEventHandler* eventHandlerPtr = Tcl_GetHashValue(hashEntryPtr); 626 627 // Ensure this handler is actually registered with the AEM 628 err = AEGetEventHandler(eventClass, 629 eventID, 630 &handler, 631 (SRefCon *) &handlerRefcon, 632 false); 633 634 if ((err != noErr) 635 || (handler != TclaeEventHandlerUPP) 636 || (handlerRefcon != (long) eventHandlerPtr)) { 637 // Something is severely wrong. 638 // The handler in the event handler hash table is either not 639 // registered with the AEM at all, or it is inconsistent 640 // with what the AEM thinks it is. 641 642 // Delete this event handler hash entry. 643 TclaeRemoveEventHandler(eventClass, eventID, hashEntryPtr); 644 645 if (err == noErr) { 646 // The AEM didn't report an error, but something was 647 // wrong anyway. Report handler not found 648 err = errAEHandlerNotFound; 649 } 650 } else { 651 // Return <handlerProc> 652 Tcl_Obj *handlerProcPtr = eventHandlerPtr->eventHandlerProc; 653 654 // Keep interpreter from deleting it 655 Tcl_IncrRefCount(handlerProcPtr); 656 657 Tcl_SetObjResult(interp, handlerProcPtr); 658 } 659 } 660 661 if (err != noErr) { 662 Tcl_ResetResult(interp); 663 Tcl_AppendResult(interp, "Couldn't find event handler: ", 664 Tcl_MacOSError(interp, err), 665 (char *) NULL); 666 return TCL_ERROR; 667 } 668 669 return TCL_OK; 670} 671 672/* ���� Handler callbacks ���� */ 673 674/* 675 * ------------------------------------------------------------------------- 676 * 677 * "TclaeCoercionHandler" -- 678 * 679 * AEM callback routine for all coercions to be handled by Tcl procs 680 * 681 * Results: 682 * MacOS error code 683 * 684 * Side effects: 685 * ??? 686 * 687 * --Version--Author------------------Changes------------------------------- 688 * 1.0 jguyer@his.com original 689 * ------------------------------------------------------------------------- 690 */ 691pascal OSErr 692TclaeCoercionHandler(DescType typeCode, 693 const void * dataPtr, 694 Size dataSize, 695 DescType toType, 696 long handlerRefcon, 697 AEDesc * resultDesc) 698{ 699 Tcl_HashEntry * hashEntryPtr; 700 tclAECoercionHandler * coercionHandlerPtr; 701 Tcl_Obj * objv[5]; 702 int result; 703 704 enum { 705 kHandlerProc = 0, 706 kTypeCode, 707 kData, 708 kToType, 709 kResultDesc 710 }; 711 712 // handlerRefcon holds the hash key for this coercion handler 713 hashEntryPtr = Tcl_FindHashEntry(tclAECoercionHandlerHashTable, (char *) handlerRefcon); 714 715 if (hashEntryPtr == NULL) { 716 // This really shouldn't happen 717 return errAEHandlerNotFound; 718 } 719 720 coercionHandlerPtr = (tclAECoercionHandler *) Tcl_GetHashValue(hashEntryPtr); 721 722 // Build up Tcl coercion handler command 723 objv[kHandlerProc] = coercionHandlerPtr->coercionHandlerProc; 724 // Ensure none of the command objects is disposed of by the interpreter 725 Tcl_IncrRefCount(objv[kHandlerProc]); 726 727 objv[kTypeCode] = TclaeNewOSTypeObj(typeCode); 728 Tcl_IncrRefCount(objv[kTypeCode]); 729 730 if (typeCode == typeChar) { 731 Tcl_DString ds; 732 733 Tcl_ExternalToUtfDString(tclAE_macRoman_encoding, dataPtr, dataSize, &ds); 734 735 objv[kData] = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); 736 737 Tcl_DStringFree(&ds); 738 } else { 739 objv[kData] = Tcl_NewByteArrayObj((unsigned char *) dataPtr, dataSize); 740 } 741 Tcl_IncrRefCount(objv[kData]); 742 743 objv[kToType] = TclaeNewOSTypeObj(toType); 744 Tcl_IncrRefCount(objv[kToType]); 745 746 objv[kResultDesc] = Tclae_NewAEDescRefObj(resultDesc); 747 Tcl_IncrRefCount(objv[kResultDesc]); 748 749 // Execute the coercion handler command 750 // [<coercionHandlerProc> <typeCode> <data> <toType> <resultDesc>] 751 result = Tcl_EvalObjv(coercionHandlerPtr->interp, 5, objv, TCL_EVAL_GLOBAL); 752 753 // Decrement, but don't delete, the handler command 754 Tcl_DecrRefCount(objv[kHandlerProc]); 755 756 Tcl_DecrRefCount(objv[kTypeCode]); 757 Tcl_DecrRefCount(objv[kData]); 758 Tcl_DecrRefCount(objv[kToType]); 759 760 // Delete the object but not the actual AEDesc (that would be Bad�) 761 TclaeDetachAEDescObj(objv[kResultDesc]); 762 763 if (result != TCL_OK) { 764 OSErr err = TclaeErrorCodeFromInterp(coercionHandlerPtr->interp); 765 766 if (err != noErr) { 767 return err; 768 } else { 769 return errAECoercionFail; 770 } 771 } else { 772 return noErr; 773 } 774} 775 776/* 777 * ------------------------------------------------------------------------- 778 * 779 * "TclaeEventHandler" -- 780 * 781 * AEM callback routine for all AppleEvents to be handled by Tcl procs 782 * 783 * Results: 784 * MacOS error code 785 * 786 * Side effects: 787 * Event is handled. Reply AppleEvent is manipulated. 788 * 789 * --Version--Author------------------Changes------------------------------- 790 * 1.0 jguyer@his.com original 791 * ------------------------------------------------------------------------- 792 */ 793static pascal OSErr 794TclaeEventHandler(const AppleEvent *theAppleEvent, 795 AppleEvent *reply, 796 long handlerRefcon) 797{ 798 Tcl_HashEntry *hashEntryPtr; 799 tclAEEventHandler *eventHandlerPtr; 800 801 // handlerRefcon holds the hash key for this event handler 802 hashEntryPtr = Tcl_FindHashEntry(tclAEEventHandlerHashTable, (char *) handlerRefcon); 803 804 if (hashEntryPtr == NULL) { 805 // This really shouldn't happen 806 return errAEHandlerNotFound; 807 } 808 809 eventHandlerPtr = (tclAEEventHandler *) Tcl_GetHashValue(hashEntryPtr); 810 811 return TclaeDispatchEvent(theAppleEvent, reply, eventHandlerPtr); 812} 813 814/* 815 * ------------------------------------------------------------------------- 816 * 817 * "TclaeReplyHandler" -- 818 * 819 * AEM callback routine for reply events from AppleEvents we sent 820 * 821 * Results: 822 * MacOS error code 823 * 824 * Side effects: 825 * Event is handled. 826 * 827 * --Version--Author------------------Changes------------------------------- 828 * 1.0 jguyer@his.com original 829 * ------------------------------------------------------------------------- 830 */ 831static pascal OSErr 832TclaeReplyHandler(const AppleEvent *theAppleEvent, 833 AppleEvent *reply, 834 long handlerRefcon) 835{ 836 Tcl_HashEntry *hashEntryPtr; 837 tclAEEventHandler *eventHandlerPtr; 838 839 OSErr err; 840 Boolean generic = false; 841 842 AEReturnID returnID; 843 DescType typeCode; 844 Size actualSize; 845 846 847 // get the returnID attribute of the event and look up the appropriate 848 // handler in the hash table 849 850 err = AEGetAttributePtr(theAppleEvent, keyReturnIDAttr, typeSInt16, 851 &typeCode, &returnID, sizeof(returnID), &actualSize); 852 853 switch (err) { 854 case noErr: { 855 long hashKey = returnID; 856 hashEntryPtr = Tcl_FindHashEntry(tclAEEventHandlerHashTable, (char *) hashKey); 857 } 858 break; 859 860 case errAECoercionFail: 861 case errAEDescNotFound: 862 // handlerRefcon holds the returnID key for generic replies 863 // (not specified by -Q) 864 hashEntryPtr = Tcl_FindHashEntry(tclAEEventHandlerHashTable, (char *) handlerRefcon); 865 866 generic = true; 867 break; 868 869 default: 870 return err; 871 } 872 873 if (hashEntryPtr == NULL) { 874 // This really shouldn't happen 875 return errAEHandlerNotFound; 876 } 877 878 879 eventHandlerPtr = (tclAEEventHandler *) Tcl_GetHashValue(hashEntryPtr); 880 881 err = TclaeDispatchEvent(theAppleEvent, reply, eventHandlerPtr); 882 883 if (!generic) { 884 // -Q handlers are one-time-only 885 Tcl_DeleteHashEntry(hashEntryPtr); 886 Tcl_DecrRefCount(eventHandlerPtr->eventHandlerProc); 887 ckfree((char *) eventHandlerPtr); 888 } 889 890 return err; 891} 892 893/* 894 * ------------------------------------------------------------------------- 895 * 896 * "TclaeDispatchEvent" -- 897 * 898 * Dispatch theAppleEvent to the appropriate Tcl proc 899 * 900 * Results: 901 * MacOS error code 902 * 903 * Side effects: 904 * Event is handled. 905 * 906 * --Version--Author------------------Changes------------------------------- 907 * 1.0 jguyer@his.com original 908 * ------------------------------------------------------------------------- 909 */ 910static OSErr 911TclaeDispatchEvent(const AppleEvent *theAppleEvent, 912 AppleEvent *reply, 913 tclAEEventHandler *eventHandlerPtr) 914{ 915 Tcl_Obj * objv[3]; 916 int result = TCL_OK; 917 CONST84_RETURN char * directResult; 918 919 // Build up Tcl event handler command 920 objv[0] = eventHandlerPtr->eventHandlerProc; 921 922 // Ensure none of the command objects is disposed of by the interpreter 923 Tcl_IncrRefCount(objv[0]); 924 925 objv[1] = Tclae_NewConstAEDescRefObj(theAppleEvent); 926 Tcl_IncrRefCount(objv[1]); 927 928 objv[2] = Tclae_NewAEDescRefObj(reply); 929 Tcl_IncrRefCount(objv[2]); 930 931 // Execute the event handler command 932 // [<eventHandlerProc> <theAppleEvent> <reply>] 933 result = Tcl_EvalObjv(eventHandlerPtr->interp, 3, objv, TCL_EVAL_GLOBAL); 934 935 // Decrement, but don't delete, the handler command 936 Tcl_DecrRefCount(objv[0]); 937 938 // Delete the objects and descriptors, 939 // but not the actual AppleEvents (that would be Bad�) 940 Tcl_DecrRefCount(objv[1]); 941 942 // Can't just decrement, as that will delete the non-const reply 943 TclaeDetachAEDescObj(objv[2]); 944 Tcl_DecrRefCount(objv[2]); 945 946 // See if there was a return value 947 directResult = Tcl_GetStringResult(eventHandlerPtr->interp); 948 949 if (result == TCL_OK) { 950 // If there was a reply from the proc, consider using it as the 951 // direct object of the reply event 952 if (strlen(directResult) > 0) { 953 OSErr err; 954 AEDesc tempDesc; 955 956 err = AEGetParamDesc(reply, 957 keyDirectObject, 958 typeWildCard, 959 &tempDesc); 960 961 AEDisposeDesc(&tempDesc); 962 963 if (err == errAEDescNotFound) { 964 Tcl_DString resultDS; 965 966 Tcl_UtfToExternalDString(tclAE_macRoman_encoding, 967 directResult, -1, 968 &resultDS); 969 970 // There was no user inserted direct object ('----'), so 971 // we insert the return value from the Tcl handler. 972 err = AEPutParamPtr(reply, 973 keyDirectObject, 974 typeChar, 975 Tcl_DStringValue(&resultDS), 976 Tcl_DStringLength(&resultDS)); 977 978 Tcl_DStringFree(&resultDS); 979 980 if (err) { 981 Tcl_ResetResult(eventHandlerPtr->interp); 982 Tcl_AppendResult(eventHandlerPtr->interp, "Couldn't put direct object: ", 983 Tcl_MacOSError(eventHandlerPtr->interp, err), 984 (char *) NULL); 985 } 986 } 987 } 988 return noErr; 989 } else { 990 OSErr err; 991 Tcl_DString resultDS; 992 993 Tcl_UtfToExternalDString(tclAE_macRoman_encoding, 994 directResult, -1, 995 &resultDS); 996 997 err = AEPutParamPtr(reply, 998 keyErrorString, 999 typeChar, 1000 Tcl_DStringValue(&resultDS), 1001 Tcl_DStringLength(&resultDS)); 1002 1003 Tcl_DStringFree(&resultDS); 1004 1005 err = TclaeErrorCodeFromInterp(eventHandlerPtr->interp); 1006 if (err != noErr) { 1007 AEPutParamPtr(reply, keyErrorNumber, typeSInt16, &err, sizeof(OSErr)); 1008 } else { 1009 Tcl_CmdInfo cmdInfo; 1010 1011 if (!Tcl_GetCommandInfo(eventHandlerPtr->interp, Tcl_GetString(eventHandlerPtr->eventHandlerProc), &cmdInfo)) { 1012 Tcl_DString resultDS; 1013 1014 Tcl_DStringInit(&resultDS); 1015 Tcl_DStringAppend(&resultDS, "invalid command name \"", -1); 1016 Tcl_DStringAppend(&resultDS, Tcl_GetString(eventHandlerPtr->eventHandlerProc), -1); 1017 Tcl_DStringAppend(&resultDS, "\"", 1); 1018 err = AEPutParamPtr(reply, 1019 keyErrorString, 1020 typeChar, 1021 Tcl_DStringValue(&resultDS), 1022 Tcl_DStringLength(&resultDS)); 1023 1024 Tcl_DStringFree(&resultDS); 1025 1026 if (err == noErr) { 1027 err = errAEHandlerNotFound; 1028 } 1029 1030 AEPutParamPtr(reply, keyErrorNumber, typeSInt16, &err, sizeof(OSErr)); 1031 } else { 1032 err = 12345; 1033 1034 AEPutParamPtr(reply, keyErrorNumber, typeSInt16, &err, sizeof(OSErr)); 1035 } 1036 } 1037 return noErr; 1038 } 1039} 1040 1041/* 1042 * ------------------------------------------------------------------------- 1043 * 1044 * "Tclaealis2TEXTHandler" -- 1045 * 1046 * Translate an AliasRecord to a path 1047 * 1048 * Results: 1049 * MacOS error code 1050 * 1051 * Side effects: 1052 * result AEDesc is set to a 'TEXT' descriptor holding the path 1053 * 1054 * --Version--Author------------------Changes------------------------------- 1055 * 1.0 jguyer@his.com original 1056 * ------------------------------------------------------------------------- 1057 */ 1058static pascal OSErr 1059Tclaealis2TEXTHandler(DescType typeCode, 1060 const void *dataPtr, 1061 Size dataSize, 1062 DescType toType, 1063 long handlerRefcon, 1064 AEDesc *resultDesc) 1065{ 1066 Boolean wasChanged; 1067 FSRef fsref; 1068 OSStatus err; 1069 AliasHandle aliasH; 1070 1071 PtrToHand(dataPtr, (Handle *) &aliasH, dataSize); 1072 1073 // Identify the target of the alias record 1074 err = FSResolveAlias(NULL, aliasH, &fsref, &wasChanged); 1075 if (err == noErr) { 1076 // use Tclaefsrf2TEXTHandler to get the paths to the file // jeg 24/07/10: Carbonization 1077 err = Tclaefsrf2TEXTHandler(typeCode, &fsref, sizeof(FSRef), toType, handlerRefcon, resultDesc); 1078 } else if (err == fnfErr) { 1079 // FSResolveAlias doesn't work for alias that don't exist yet 1080 // so we need to be a bit more creative 1081 1082 // None of this will work on Mac OS X 1083 // For some hammer-headed reason, alias AEDescs /cannot/ refer 1084 // to a file that doesn't exist yet (tn2022), even though that's a 1085 // major reason to have aliases in the first place!!! 1086 CFStringRef pathString; 1087 1088 err = FSCopyAliasInfo(aliasH, NULL,NULL, &pathString, NULL, NULL); 1089 if (err == noErr) { 1090 Tcl_DString ds; 1091 1092 if (CFStringToExternalDString(NULL, pathString, &ds) == TCL_OK) { 1093 err = AECreateDesc(typeText, 1094 Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 1095 resultDesc); 1096 } else { 1097 err = paramErr; 1098 } 1099 1100 Tcl_DStringFree(&ds); 1101 CFRelease(pathString); 1102 } 1103 } 1104 DisposeHandle((Handle) aliasH); 1105 return err; 1106 1107 // tclAE::coerceDesc [tclAE::build::alis "/Volumes/programming/Alpha/Head/Alpha/Alpha Sources/iggy.c"] TEXT 1108} 1109 1110/* 1111 * ------------------------------------------------------------------------- 1112 * 1113 * "Tclaefsrf2TEXTHandler" -- 1114 * 1115 * Translate an FSRef to a path 1116 * 1117 * Results: 1118 * MacOS error code 1119 * 1120 * Side effects: 1121 * result AEDesc is set to a 'TEXT' descriptor holding the path 1122 * 1123 * --Version--Author------------------Changes------------------------------- 1124 * 1.0 jguyer@his.com original 1125 * ------------------------------------------------------------------------- 1126 */ 1127static pascal OSErr 1128Tclaefsrf2TEXTHandler(DescType typeCode, 1129 const void * dataPtr, 1130 Size dataSize, 1131 DescType toType, 1132 long handlerRefcon, 1133 AEDesc * resultDesc) 1134{ 1135 int len; 1136 OSErr err; 1137 Handle pathH; 1138 1139 // Obtain the path to the file 1140 err = FSpPathFromLocation((FSRef *) dataPtr, &len, &pathH); 1141 if (err == noErr) { 1142 HLock(pathH); 1143 // FSpPathFromLocation() returns a C string, so strip the trailing '\0' 1144 err = AECreateDesc(toType, *pathH, len, resultDesc); 1145 DisposeHandle(pathH); 1146 } 1147 return err; 1148} 1149 1150/* 1151 * ------------------------------------------------------------------------- 1152 * 1153 * "TclaeTEXT2alisHandler" -- 1154 * 1155 * Translate a path to an AliasRecord 1156 * 1157 * Results: 1158 * MacOS error code 1159 * 1160 * Side effects: 1161 * result AEDesc is set to an 'alis' descriptor for the file 1162 * 1163 * --Version--Author------------------Changes------------------------------- 1164 * 1.0 jguyer@his.com original 1165 * ------------------------------------------------------------------------- 1166 */ 1167static pascal OSErr 1168TclaeTEXT2alisHandler(DescType dataType, 1169 const void * dataPtr, 1170 Size dataSize, 1171 DescType toType, 1172 long refCon, 1173 AEDesc * resultDesc) 1174{ 1175#ifdef TCLAE_CARBON_USE_CFURL 1176 OSErr err = noErr; 1177 CFURLRef url = NULL; 1178 CFDataRef dataRef = NULL; 1179 1180 url=CFURLCreateFromFileSystemRepresentation(kCFAllocatorDefault, dataPtr, dataSize, TRUE); 1181 if (url == NULL) return coreFoundationUnknownErr; 1182 dataRef = CFURLCreateData(kCFAllocatorDefault, url, kCFStringEncodingUTF8, true); 1183 if (dataRef) { 1184 CFIndex dataSize = CFDataGetLength(dataRef); 1185 err = AECreateDesc(typeFileURL, (Ptr)CFDataGetBytePtr(dataRef), dataSize, resultDesc); 1186 CFRelease(dataRef); 1187 CFRelease(url); 1188 } else err = coreFoundationUnknownErr; 1189 1190 return err; 1191#else 1192 FSRef fsref; 1193 AliasHandle alisH; 1194 OSErr err; 1195 1196 /* Use this instead of FSNewAliasMinimalUnicode() first so that 1197 * we can get alii of partial paths, too. Nifty. 1198 */ 1199 err = FSpLocationFromPath(dataSize, dataPtr, &fsref); 1200 1201 switch (err) { 1202 case noErr: { 1203 UniChar targetName[1]; 1204 1205 FSNewAliasMinimalUnicode(&fsref, 0, targetName, &alisH, NULL); 1206 } 1207 break; 1208 1209#if TARGET_API_MAC_OS8 1210 case fnfErr: { 1211 err = NewAliasMinimal(&fss, &alisH); 1212 /* The file doesn't exist, so FSpLocationFromPath() won't work. 1213 * Do the best we can with NewAliasMinimalFromFullPath(). 1214 * Ultimately, we should implement an alias version of FSpLocationFromPath() 1215 */ 1216 if (err != noErr) 1217 err = NewAliasMinimalFromFullPath(dataSize, dataPtr, "\p", "\p", &alisH); 1218#if TARGET_API_MAC_OSX 1219 if (err == paramErr) { 1220 /* possibly we were passed a POSIX path and NewAliasMinimalFromFullPath() 1221 * needs an HFS path (although Apple has not deigned to document that 1222 * #*%! fact). 1223 */ 1224 1225 Tcl_DString ds; 1226 int result; 1227 1228 Tcl_ExternalToUtfDString(tclAE_macRoman_encoding, 1229 dataPtr, dataSize, &ds); 1230 1231 result = TclaeGetPathDString(NULL, 1232 Tcl_NewStringObj(Tcl_DStringValue(&ds), 1233 Tcl_DStringLength(&ds)), 1234 FALSE, 1235 kCFURLPOSIXPathStyle, kCFURLHFSPathStyle, &ds); 1236 1237 Tcl_UtfToExternalDString(tclAE_macRoman_encoding, 1238 Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), &ds); 1239 1240 err = NewAliasMinimalFromFullPath(Tcl_DStringLength(&ds), Tcl_DStringValue(&ds), 1241 "", "", &alisH); 1242 } 1243#endif 1244 } 1245 break; 1246#endif 1247 } 1248 1249 if (err == noErr) { 1250 HLock((Handle) alisH); 1251 err = AECreateDesc(toType, *alisH, GetHandleSize((Handle) alisH), resultDesc); 1252 DisposeHandle((Handle) alisH); 1253 } 1254 1255 return err; 1256#endif 1257} 1258 1259/* 1260 * ------------------------------------------------------------------------- 1261 * 1262 * "TclaeTEXT2fsrfHandler" -- 1263 * 1264 * Translate a path to an FSRef 1265 * 1266 * Results: 1267 * MacOS error code 1268 * 1269 * Side effects: 1270 * result AEDesc is set to an 'fsrf' descriptor for the file 1271 * 1272 * --Version--Author------------------Changes------------------------------- 1273 * 1.0 jguyer@his.com original 1274 * ------------------------------------------------------------------------- 1275 */ 1276static pascal OSErr 1277TclaeTEXT2fsrfHandler(DescType dataType, 1278 const void *dataPtr, 1279 Size dataSize, 1280 DescType toType, 1281 long refCon, 1282 AEDesc *resultDesc) 1283{ 1284 FSRef fsref; 1285 OSErr err; 1286 1287 err = FSpLocationFromPath(dataSize, dataPtr, &fsref); 1288 1289 if (err == noErr) { 1290 err = AECreateDesc(toType, &fsref, sizeof(FSRef), resultDesc); 1291 } 1292 1293 return err; 1294} 1295 1296#if !__LP64__ 1297/* 1298 * ------------------------------------------------------------------------- 1299 * 1300 * "Tclaefss_2TEXTHandler" -- 1301 * 1302 * Translate an FSSpec to a path 1303 * 1304 * Results: 1305 * MacOS error code 1306 * 1307 * Side effects: 1308 * result AEDesc is set to a 'TEXT' descriptor holding the path 1309 * 1310 * --Version--Author------------------Changes------------------------------- 1311 * 1.0 jguyer@his.com original 1312 * ------------------------------------------------------------------------- 1313 */ 1314static pascal OSErr 1315Tclaefss_2TEXTHandler(DescType typeCode, 1316 const void * dataPtr, 1317 Size dataSize, 1318 DescType toType, 1319 long handlerRefcon, 1320 AEDesc * resultDesc) 1321{ 1322 OSErr err; 1323 FSRef fsref; 1324 1325 // Obtain an FSRef to the file 1326 err = FSpMakeFSRef((FSSpec *) dataPtr, &fsref); 1327 if (err == noErr) { 1328 err = Tclaefsrf2TEXTHandler(typeFSS, &fsref, sizeof(fsref), typeFSRef, handlerRefcon, resultDesc); 1329 } 1330 return err; 1331} 1332 1333/* 1334 * ------------------------------------------------------------------------- 1335 * 1336 * "TclaeTEXT2fss_Handler" -- 1337 * 1338 * Translate a path to an FSSpec 1339 * 1340 * Results: 1341 * MacOS error code 1342 * 1343 * Side effects: 1344 * result AEDesc is set to an 'fss ' descriptor for the file 1345 * 1346 * --Version--Author------------------Changes------------------------------- 1347 * 1.0 jguyer@his.com original 1348 * ------------------------------------------------------------------------- 1349 */ 1350static pascal OSErr 1351TclaeTEXT2fss_Handler(DescType dataType, 1352 const void *dataPtr, 1353 Size dataSize, 1354 DescType toType, 1355 long refCon, 1356 AEDesc *resultDesc) 1357{ 1358 FSRef fsref; 1359 OSErr err; 1360 1361 err = FSpLocationFromPath(dataSize, dataPtr, &fsref); 1362 1363 if (err == noErr) { 1364 FSSpec fss; 1365 err = FSGetCatalogInfo(&fsref,kFSCatInfoNone,NULL,NULL,&fss,NULL); 1366 if (err == noErr) { 1367 err = AECreateDesc(toType, &fss, sizeof(FSSpec), resultDesc); 1368 } 1369 } 1370 1371 return err; 1372} 1373#endif // !__LP64__ 1374 1375/* 1376 * ------------------------------------------------------------------------- 1377 * 1378 * "TclaeWILD2TEXTHandler" -- 1379 * 1380 * raw data as text 1381 * 1382 * Results: 1383 * MacOS error code 1384 * 1385 * Side effects: 1386 * result AEDesc is set to a 'TEXT' descriptor holding the data 1387 * 1388 * --Version--Author------------------Changes------------------------------- 1389 * 1.0 jguyer@his.com original 1390 * ------------------------------------------------------------------------- 1391 */ 1392static pascal OSErr 1393TclaeWILD2TEXTHandler(DescType typeCode, 1394 const void *dataPtr, 1395 Size dataSize, 1396 DescType toType, 1397 long handlerRefcon, 1398 AEDesc *resultDesc) 1399{ 1400 return AECreateDesc(typeChar, dataPtr, dataSize, resultDesc); 1401} 1402 1403/* ���� Internal package routines ���� */ 1404 1405/* 1406 * ------------------------------------------------------------------------- 1407 * 1408 * "TclaeErrorCodeFromInterp" -- 1409 * 1410 * Attempt to extract an integer error code from the interpreter result code. 1411 * This routine assumes that it's been called in response to a TCL_ERROR. 1412 * 1413 * It expects errorCode to be: 1414 * <integer> 1415 * or 1416 * {<category> <integer> <message>} 1417 * 1418 * or the result to be an integer. 1419 * 1420 * 1421 * Results: 1422 * An OSErr. 1423 * 1424 * Side effects: 1425 * None. 1426 * ------------------------------------------------------------------------- 1427 */ 1428 1429OSErr 1430TclaeErrorCodeFromInterp(Tcl_Interp *interp) 1431{ 1432 Tcl_Obj * errorCodePtr; 1433 int result; /* result from Tcl calls */ 1434 int errorCode = noErr; 1435 1436 // Get the error code 1437 errorCodePtr = Tcl_ObjGetVar2(interp, 1438 Tcl_NewStringObj("errorCode", -1), 1439 NULL, 1440 TCL_GLOBAL_ONLY); 1441 1442 // See if errorCode is an integer 1443 result = Tcl_GetIntFromObj(NULL, errorCodePtr, &errorCode); 1444 1445 // If not� 1446 if (result != TCL_OK) { 1447 int listLength; 1448 1449 // See if errorCode is a list 1450 result = Tcl_ListObjLength(NULL, errorCodePtr, &listLength); 1451 if ((result == TCL_OK) 1452 && (listLength >= 2)) { 1453 Tcl_Obj * errorSubCodePtr; 1454 1455 // See if second item is an integer 1456 result = Tcl_ListObjIndex(NULL, errorCodePtr, 1, &errorSubCodePtr); 1457 if (result == TCL_OK) { 1458 result = Tcl_GetIntFromObj(NULL, errorSubCodePtr, &errorCode); 1459 } 1460 } 1461 } 1462 1463 // No error code found, so see if the result was an integer 1464 if (errorCode == noErr) { 1465 errorCodePtr = Tcl_GetObjResult(interp); 1466 result = Tcl_GetIntFromObj(NULL, errorCodePtr, &errorCode); 1467 } 1468 1469 return errorCode; // coerce integer to 16-bit OSErr 1470} 1471 1472/* 1473 * ------------------------------------------------------------------------- 1474 * 1475 * "TclaeInitAEHandlerHashTable" -- 1476 * 1477 * Initialize hash table for AE handlers, allowing AppleEvents to be 1478 * handled by Tcl procs. 1479 * 1480 * Results: 1481 * None. 1482 * 1483 * Side effects: 1484 * None. 1485 * ------------------------------------------------------------------------- 1486 */ 1487int 1488TclaeInitEventHandlers(Tcl_Interp *interp) 1489{ 1490 OSErr err; 1491 tclAEEventHandler *eventHandlerPtr = NULL; 1492 Tcl_HashEntry *hashEntryPtr; 1493 int isNew = 0; 1494 long handlerRefcon; 1495 1496 // Initialize the AE Handler hash table 1497 tclAEEventHandlerHashTable = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable)); 1498 if (tclAEEventHandlerHashTable) { 1499 Tcl_InitHashTable(tclAEEventHandlerHashTable, TCL_ONE_WORD_KEYS); 1500 } else { 1501 Tcl_ResetResult(interp); 1502 Tcl_AppendResult(interp, "Couldn't initialize AppleEvent handlers", 1503 (char *) NULL); 1504 return TCL_ERROR; 1505 } 1506 1507 // Set up the generic reply handler 1508 eventHandlerPtr = (tclAEEventHandler *) ckalloc(sizeof(tclAEEventHandler)); 1509 1510 eventHandlerPtr->eventClass = kCoreEventClass; 1511 eventHandlerPtr->eventID = kAEAnswer; 1512 1513 // Assign the Tcl proc which is to handle this event 1514 eventHandlerPtr->interp = interp; 1515 eventHandlerPtr->eventHandlerProc = Tcl_NewStringObj("aeom::handleAnswer", -1); 1516 // Keep proc from being deleted by the interpreter 1517 Tcl_IncrRefCount(eventHandlerPtr->eventHandlerProc); 1518 1519 do { 1520 long hashKey = ++gReturnID; 1521 hashEntryPtr = Tcl_CreateHashEntry(tclAEEventHandlerHashTable, 1522 (char *) hashKey, &isNew); 1523 } while (!isNew); 1524 1525 1526 // Set hash entry to point at the event handler record 1527 Tcl_SetHashValue(hashEntryPtr, eventHandlerPtr); 1528 1529 1530 // Register generic reply handler with the AEM 1531 if (!TclaeReplyHandlerUPP) { 1532 TclaeReplyHandlerUPP = NewAEEventHandlerUPP(TclaeReplyHandler); 1533 } 1534 handlerRefcon = gReturnID; 1535 err = AEInstallEventHandler(kCoreEventClass, kAEAnswer, 1536 TclaeReplyHandlerUPP, (SRefCon) handlerRefcon, false); 1537 if (err != noErr) { 1538 Tcl_ResetResult(interp); 1539 Tcl_AppendResult(interp, "Couldn't install reply handler: ", 1540 Tcl_MacOSError(interp, err), 1541 (char *) NULL); 1542 return TCL_ERROR; 1543 } 1544 1545 err = AESetInteractionAllowed(kAEInteractWithAll); 1546 if (err != noErr) { 1547 Tcl_ResetResult(interp); 1548 Tcl_AppendResult(interp, "Couldn't set interaction to kAEInteractWithAll: ", 1549 Tcl_MacOSError(interp, err), 1550 (char *) NULL); 1551 return TCL_ERROR; 1552 } 1553 1554 return TCL_OK; 1555} 1556 1557/* 1558 * ------------------------------------------------------------------------- 1559 * 1560 * "TclaeInitCoercionHandlers" -- 1561 * 1562 * Initialize coercion handlers. 1563 * 1564 * Results: 1565 * None. 1566 * 1567 * Side effects: 1568 * Coercion handlers activated. 1569 * ------------------------------------------------------------------------- 1570 */ 1571void 1572TclaeInitCoercionHandlers(Tcl_Interp *interp) 1573{ 1574 OSErr err; 1575 1576 Tclaealis2TEXTHandlerUPP = NewAECoercePtrUPP(Tclaealis2TEXTHandler); 1577 TclaeTEXT2alisHandlerUPP = NewAECoercePtrUPP(TclaeTEXT2alisHandler); 1578 Tclaefsrf2TEXTHandlerUPP = NewAECoercePtrUPP(Tclaefsrf2TEXTHandler); 1579 TclaeTEXT2fsrfHandlerUPP = NewAECoercePtrUPP(TclaeTEXT2fsrfHandler); 1580#if !__LP64__ 1581 Tclaefss_2TEXTHandlerUPP = NewAECoercePtrUPP(Tclaefss_2TEXTHandler); 1582 TclaeTEXT2fss_HandlerUPP = NewAECoercePtrUPP(TclaeTEXT2fss_Handler); 1583#endif // !__LP64__ 1584 TclaeWILD2TEXTHandlerUPP = NewAECoercePtrUPP(TclaeWILD2TEXTHandler); 1585 1586 err = AEInstallCoercionHandler(typeAlias, typeChar, (AECoercionHandlerUPP)Tclaealis2TEXTHandlerUPP, 0L, false, false); 1587 err = AEInstallCoercionHandler(typeChar, typeAlias, (AECoercionHandlerUPP)TclaeTEXT2alisHandlerUPP, 0L, false, false); 1588 err = AEInstallCoercionHandler(typeFSRef, typeChar, (AECoercionHandlerUPP)Tclaefsrf2TEXTHandlerUPP, 0L, false, false); 1589 err = AEInstallCoercionHandler(typeChar, typeFSRef, (AECoercionHandlerUPP)TclaeTEXT2fsrfHandlerUPP, 0L, false, false); 1590#if !__LP64__ 1591 err = AEInstallCoercionHandler(typeFSS, typeChar, (AECoercionHandlerUPP)Tclaefss_2TEXTHandlerUPP, 0L, false, false); 1592 err = AEInstallCoercionHandler(typeChar, typeFSS, (AECoercionHandlerUPP)TclaeTEXT2fss_HandlerUPP, 0L, false, false); 1593#endif // !__LP64__ 1594// err = AEInstallCoercionHandler(typeWildCard, typeChar, (AECoercionHandlerUPP)TclaeWILD2TEXTHandlerUPP, 0L, false, false); 1595 1596 /* Initialize the AE Handler hash table */ 1597 tclAECoercionHandlerHashTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); 1598 if (tclAECoercionHandlerHashTable) { 1599 Tcl_InitHashTable(tclAECoercionHandlerHashTable, TCL_ONE_WORD_KEYS); 1600 } else { 1601 Tcl_ResetResult(interp); 1602 Tcl_AppendResult(interp, "Couldn't initialize coercion handlers", 1603 (char *) NULL); 1604 } 1605} 1606 1607 1608/* 1609 * ------------------------------------------------------------------------- 1610 * 1611 * "TclaeRegisterQueueHandler" -- 1612 * 1613 * Tcl wrapper for ToolBox AEInstallEventHandler call. 1614 * This allows Tcl procs to act as event handlers. 1615 * 1616 * Results: 1617 * AEReturnID for this call, permitting reply to be assosciated with 1618 * original call 1619 * 1620 * Side effects: 1621 * <handlerProc> is registered and added to the event handler hash 1622 * 1623 * --Version--Author------------------Changes------------------------------- 1624 * 1.0 jguyer@his.com original 1625 * ------------------------------------------------------------------------- 1626 */ 1627AEReturnID 1628TclaeRegisterQueueHandler( 1629 Tcl_Interp *interp, 1630 Tcl_Obj *replyHandlerProc) 1631{ 1632 Tcl_HashEntry *hashEntryPtr; 1633 tclAEEventHandler *eventHandlerPtr = NULL; 1634 int isNew = 0; 1635 1636 1637 /* 1638 * This event handler will _not_ be registered with the AEM. 1639 * Rather, our generic aevt\ansr handler will look this up 1640 * when it receives a reply event. 1641 */ 1642 eventHandlerPtr = (tclAEEventHandler *) ckalloc(sizeof(tclAEEventHandler)); 1643 1644 /* Would it be better to set these to the class and ID of 1645 * the sent event? 1646 */ 1647 eventHandlerPtr->eventClass = kCoreEventClass; 1648 eventHandlerPtr->eventID = kAEAnswer; 1649 1650 // Assign the Tcl proc which is to handle this event 1651 eventHandlerPtr->interp = interp; 1652 eventHandlerPtr->eventHandlerProc = replyHandlerProc; 1653 // Keep proc from being deleted by the interpreter 1654 Tcl_IncrRefCount(replyHandlerProc); 1655 1656 do { 1657 long hashKey = ++gReturnID; 1658 hashEntryPtr = Tcl_CreateHashEntry(tclAEEventHandlerHashTable, 1659 (char *) hashKey, &isNew); 1660 } while (!isNew); 1661 1662 // Set hash entry to point at the event handler record 1663 Tcl_SetHashValue(hashEntryPtr, eventHandlerPtr); 1664 1665 return gReturnID; 1666} 1667 1668 1669/* 1670 * ------------------------------------------------------------------------- 1671 * 1672 * "TclaeGetCoercionHandler" -- 1673 * 1674 * Find specified entry in hash table for coercion handlers 1675 * If handlerProc is not NULL, it must match 1676 * 1677 * Results: 1678 * Tcl_HashEntry pointer (or NULL) for desired handler 1679 * 1680 * Side effects: 1681 * None. 1682 * ------------------------------------------------------------------------- 1683 */ 1684static Tcl_HashEntry* 1685TclaeGetCoercionHandler( 1686 Tcl_Interp* interp, 1687 OSType fromType, 1688 OSType toType, 1689 char* handlerProc) 1690{ 1691 Tcl_HashEntry *hashEntryPtr; /* for search of AECoercionHandler */ 1692 Tcl_HashSearch search; /* hash list */ 1693 tclAECoercionHandler *coercionHandlerPtr; 1694 1695 // Search through coercion handler hash table for this type pair 1696 for (hashEntryPtr = Tcl_FirstHashEntry(tclAECoercionHandlerHashTable, &search); 1697 hashEntryPtr != NULL; 1698 hashEntryPtr = Tcl_NextHashEntry(&search)) { 1699 1700 coercionHandlerPtr = Tcl_GetHashValue(hashEntryPtr); 1701 if ((coercionHandlerPtr->fromType == fromType) 1702 && (coercionHandlerPtr->toType == toType) 1703 && (coercionHandlerPtr->interp == interp)) { 1704 if (handlerProc 1705 && (strcmp(handlerProc, 1706 Tcl_GetString(coercionHandlerPtr->coercionHandlerProc)) != 0)) { 1707 // handlerProc doesn't match 1708 continue; 1709 } else { 1710 // found 1711 break; 1712 } 1713 } 1714 } 1715 1716 return hashEntryPtr; 1717} 1718 1719 1720/* 1721 * ------------------------------------------------------------------------- 1722 * 1723 * "TclaeGetEventHandler" -- 1724 * 1725 * Find specified entry in hash table for event handlers 1726 * If handlerProc is not NULL, it must match 1727 * 1728 * Results: 1729 * Tcl_HashEntry pointer (or NULL) for desired handler 1730 * 1731 * Side effects: 1732 * None. 1733 * ------------------------------------------------------------------------- 1734 */ 1735static Tcl_HashEntry* 1736TclaeGetEventHandler( 1737 Tcl_Interp* interp, 1738 OSType eventClass, 1739 OSType eventID, 1740 char* handlerProc) 1741{ 1742 Tcl_HashEntry *hashEntryPtr; /* for search of AEEventHandler */ 1743 Tcl_HashSearch search; /* hash list */ 1744 tclAEEventHandler *eventHandlerPtr; 1745 1746 // Search through event handler hash table for this class and ID 1747 for (hashEntryPtr = Tcl_FirstHashEntry(tclAEEventHandlerHashTable, &search); 1748 hashEntryPtr != NULL; 1749 hashEntryPtr = Tcl_NextHashEntry(&search)) { 1750 1751 eventHandlerPtr = Tcl_GetHashValue(hashEntryPtr); 1752 if ((eventHandlerPtr->eventClass == eventClass) 1753 && (eventHandlerPtr->eventID == eventID) 1754 && (eventHandlerPtr->interp == interp)) { 1755 if (handlerProc 1756 && (strcmp(handlerProc, 1757 Tcl_GetString(eventHandlerPtr->eventHandlerProc)) != 0)) { 1758 // handlerProc doesn't match 1759 continue; 1760 } else { 1761 // found 1762 break; 1763 } 1764 } 1765 } 1766 1767 return hashEntryPtr; 1768} 1769 1770 1771/* 1772 * ------------------------------------------------------------------------- 1773 * 1774 * "TclaeRemoveCoercionHandler" -- 1775 * 1776 * Remove entry from hash table for coercion handlers, and deregister 1777 * coercion with the AEM 1778 * 1779 * Results: 1780 * OS Error 1781 * 1782 * Side effects: 1783 * Specified coercion is removed 1784 * ------------------------------------------------------------------------- 1785 */ 1786static OSErr 1787TclaeRemoveCoercionHandler( 1788 OSType fromType, 1789 OSType toType, 1790 Tcl_HashEntry* hashEntryPtr) 1791{ 1792 tclAECoercionHandler* coercionHandlerPtr = Tcl_GetHashValue(hashEntryPtr); 1793 1794 // Delete the object holding the handler proc 1795 Tcl_DecrRefCount(coercionHandlerPtr->coercionHandlerProc); 1796 // Remove the coercion hash entry 1797 Tcl_DeleteHashEntry(hashEntryPtr); 1798 // Delete the coercion handler structure 1799 ckfree((char*) coercionHandlerPtr); 1800 1801 // Deregister any coercion for this type-pair with the AEM 1802 return AERemoveCoercionHandler(fromType, 1803 toType, 1804 (AECoercionHandlerUPP)TclaeCoercionHandlerUPP, 1805 false); 1806} 1807 1808 1809 1810/* 1811 * ------------------------------------------------------------------------- 1812 * 1813 * "TclaeRemoveEventHandler" -- 1814 * 1815 * Remove entry from hash table for event handlers, and deregister 1816 * handler with the AEM 1817 * 1818 * Results: 1819 * OS Error 1820 * 1821 * Side effects: 1822 * Specified handler is removed 1823 * ------------------------------------------------------------------------- 1824 */ 1825static OSErr 1826TclaeRemoveEventHandler( 1827 OSType eventClass, 1828 OSType eventID, 1829 Tcl_HashEntry* hashEntryPtr) 1830{ 1831 tclAEEventHandler* eventHandlerPtr = Tcl_GetHashValue(hashEntryPtr); 1832 1833 // Delete the object holding the handler proc 1834 Tcl_DecrRefCount(eventHandlerPtr->eventHandlerProc); 1835 // Remove the coercion hash entry 1836 Tcl_DeleteHashEntry(hashEntryPtr); 1837 // Delete the coercion handler structure 1838 ckfree((char*) eventHandlerPtr); 1839 1840 // Deregister this handler with the AEM 1841 return AERemoveEventHandler(eventClass, 1842 eventID, 1843 TclaeEventHandlerUPP, 1844 false); 1845} 1846 1847 1848/*==================== POSIX to HFS path conversion =====================*/ 1849 1850#if TARGET_API_MAC_CARBON 1851/* 1852 * ------------------------------------------------------------------------- 1853 * 1854 * "TclaeGetPathDString" -- 1855 * 1856 * Places the (HFS or POSIX) path for the supplied (POSIX or HFS) path 1857 * in the supplied DString. 1858 * 1859 * Results: 1860 * Tcl status. 1861 * 1862 * Side effects: 1863 * None. 1864 * ------------------------------------------------------------------------- 1865 */ 1866static int 1867TclaeGetPathDString(Tcl_Interp *interp, Tcl_Obj *inPath, 1868 Boolean isDirectory, CFURLPathStyle fromPathStyle, 1869 CFURLPathStyle toPathStyle, Tcl_DString *outDS) 1870{ 1871 CFStringRef strRef; 1872 CFURLRef urlRef; 1873 int result; 1874 1875 if (UtfToDUtfDString(interp, Tcl_GetString(inPath), -1, outDS) == TCL_ERROR) 1876 return TCL_ERROR; 1877 strRef = CFStringCreateWithCStringNoCopy(NULL, Tcl_DStringValue(outDS), 1878 kCFStringEncodingUTF8, kCFAllocatorNull); 1879 1880 if (strRef == NULL) { 1881 Tcl_SetResult(interp, "Can't allocate CFString", TCL_STATIC); 1882 return TCL_ERROR; 1883 } 1884 1885 urlRef = CFURLCreateWithFileSystemPath(NULL, strRef, 1886 fromPathStyle, isDirectory); 1887 CFRelease(strRef); 1888 Tcl_DStringFree(outDS); 1889 if (urlRef == NULL) { 1890 Tcl_ResetResult(interp); 1891 Tcl_AppendResult(interp, "Can't get CFURL from '", 1892 Tcl_GetString(inPath), "'", 1893 (char *) NULL); 1894 return TCL_ERROR; 1895 } 1896 1897 strRef = CFURLCopyFileSystemPath(urlRef, toPathStyle); 1898 CFRelease(urlRef); 1899 if (strRef == NULL) { 1900 Tcl_ResetResult(interp); 1901 Tcl_AppendResult(interp, "Can't get path from '", 1902 Tcl_GetString(inPath), "'", 1903 (char *) NULL); 1904 return TCL_ERROR; 1905 } 1906 1907 result = CFStringToUtfDString(interp, strRef, outDS); 1908 CFRelease(strRef); 1909 1910 return result; 1911} 1912 1913/* 1914 * ------------------------------------------------------------------------- 1915 * 1916 * "TclaeGetPath" -- 1917 * 1918 * Return the (HFS or POSIX) path for the supplied (POSIX or HFS) path. 1919 * 1920 * Results: 1921 * Translated path. 1922 * 1923 * Side effects: 1924 * None. 1925 * ------------------------------------------------------------------------- 1926 */ 1927static int 1928TclaeGetPath(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], 1929 CFURLPathStyle fromPathStyle, CFURLPathStyle toPathStyle) 1930{ 1931 Boolean isDirectory = TRUE; 1932 Tcl_DString ds; 1933 int result; 1934 1935 if ((objc < 2) || (objc > 3)) { 1936 Tcl_WrongNumArgs(interp, 1, objv, "<path> ?isDirectory?"); 1937 return TCL_ERROR; 1938 } 1939 if (objc == 3) { 1940 int tmp; 1941 1942 if (Tcl_GetBooleanFromObj(interp, objv[2], &tmp) != TCL_OK) { 1943 return TCL_ERROR; 1944 } 1945 1946 isDirectory = tmp; 1947 } 1948 1949 result = TclaeGetPathDString(interp, objv[1], isDirectory, fromPathStyle, 1950 toPathStyle, &ds); 1951 1952 if (result == TCL_OK) { 1953 Tcl_DStringResult(interp, &ds); 1954 } 1955 Tcl_DStringFree(&ds); 1956 1957 return result; 1958} 1959 1960/* 1961 * ------------------------------------------------------------------------- 1962 * 1963 * "Tclae_GetPOSIXPathCmd" -- 1964 * 1965 * Return the POSIX path for the supplied HFS path. 1966 * 1967 * Results: 1968 * POSIX path. 1969 * 1970 * Side effects: 1971 * None. 1972 * ------------------------------------------------------------------------- 1973 */ 1974int 1975Tclae_GetPOSIXPathCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) 1976{ 1977 return TclaeGetPath(interp, objc, objv, kCFURLHFSPathStyle, kCFURLPOSIXPathStyle); 1978} 1979 1980/* 1981 * ------------------------------------------------------------------------- 1982 * 1983 * "Tclae_GetHFSPathCmd" -- 1984 * 1985 * Return the HFS path for the supplied POSIX path. 1986 * 1987 * Results: 1988 * HFS path. 1989 * 1990 * Side effects: 1991 * None. 1992 * ------------------------------------------------------------------------- 1993 */ 1994int 1995Tclae_GetHFSPathCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) 1996{ 1997 return TclaeGetPath(interp, objc, objv, kCFURLPOSIXPathStyle, kCFURLHFSPathStyle); 1998} 1999#endif // TARGET_API_MAC_CARBON 2000