1/* -*- mode: C; coding: macintosh; -*- 2 * ################################################################### 3 * TclAE - AppleEvent extension for Tcl 4 * 5 * FILE: "tclAEDesc.c" 6 * created: 1/20/2000 {10:47:47 PM} 7 * last update: 7/30/10 {11:54:40 PM} 8 * Author: Jonathan Guyer 9 * E-mail: jguyer@his.com 10 * mail: Alpha Cabal 11 * www: http://www.his.com/jguyer/ 12 * 13 * ======================================================================== 14 * Copyright (c) 2000-2004 Jonathan Guyer 15 * All rights reserved 16 * ======================================================================== 17 * Permission to use, copy, modify, and distribute this software and its 18 * documentation for any purpose and without fee is hereby granted, 19 * provided that the above copyright notice appear in all copies and that 20 * both that the copyright notice and warranty disclaimer appear in 21 * supporting documentation. 22 * 23 * Jonathan Guyer disclaims all warranties with regard to this software, 24 * including all implied warranties of merchantability and fitness. In 25 * no event shall Jonathan Guyer be liable for any special, indirect or 26 * consequential damages or any damages whatsoever resulting from loss of 27 * use, data or profits, whether in an action of contract, negligence or 28 * other tortuous action, arising out of or in connection with the use or 29 * performance of this software. 30 * ======================================================================== 31 * See header file for further information 32 * ################################################################### 33 */ 34 35#ifdef TCLAE_USE_FRAMEWORK_INCLUDES 36#include <Carbon/Carbon.h> 37#else 38#if TARGET_API_MAC_CARBON // das 25/10/00: Carbonization 39#include <AEHelpers.h> 40#else 41#include <AEBuild.h> 42#include "AEPrintCarbon.h" 43#endif 44#endif 45 46#include <string.h> 47 48#ifdef MAC_TCL 49#include <tclMacInt.h> 50#endif 51 52#include "tclAEInt.h" 53#include "tclMacOSError.h" 54 55static CmdReturn *rawFromAEDesc(Tcl_Interp *interp, const AEDesc *theAEDescPtr); 56static CmdReturn *dataFromAEDesc(Tcl_Interp *interp, const AEDesc *theAEDescPtr); 57 58 59 60/* ���� Public package routines ���� */ 61 62/* 63 * ------------------------------------------------------------------------- 64 * 65 * "Tclae_CoerceDataCmd" -- 66 * 67 * Tcl wrapper for ToolBox AECoercePtr call. 68 * It doesn't really mean anything to pass a pointer in Tcl, so pass the 69 * data directly. 70 * 71 * tclAE::coerceData <typeCode> <data> <toType> 72 * 73 * Results: 74 * Tcl result code 75 * 76 * Side effects: 77 * result of interp is set to new AEDesc object 78 * ------------------------------------------------------------------------- 79 */ 80int 81Tclae_CoerceDataCmd(ClientData clientData, /* (unused) */ 82 Tcl_Interp *interp, /* for results */ 83 int objc, /* number of arguments */ 84 Tcl_Obj *const objv[]) /* argument objects */ 85{ 86 OSErr err; /* result from ToolBox calls */ 87 void* dataPtr; /* pointer to data */ 88 Size dataSize; /* length of data */ 89 AEDesc* toAEDescPtr; /* pointer to coerced AEDesc */ 90 OSType typeCode; /* type code of original data */ 91 92 enum { 93 kTypeCode = 1, 94 kData, 95 kToType 96 }; 97 98 if (objc != 4) { 99 Tcl_WrongNumArgs(interp, 1, objv, "typeCode data toType"); 100 return TCL_ERROR; 101 } 102 103 typeCode = TclaeGetOSTypeFromObj(objv[kTypeCode]); 104 105 /* Extract <data> */ 106 dataPtr = TclaeDataFromObj(interp, typeCode, objv[kData], &dataSize); 107 if (dataPtr == NULL) { 108 return TCL_ERROR; 109 } 110 111 /* Allocate the coerced AEDesc */ 112 toAEDescPtr = (AEDesc *) ckalloc(sizeof(AEDesc)); 113 if (toAEDescPtr == NULL) { 114 ckfree(dataPtr); 115 return TCL_ERROR; 116 } 117 118 /* Create an empty AEDesc with of type <typeCode> */ 119 err = AECreateDesc(typeNull, NULL, 0L, toAEDescPtr); 120 121 122 /* Coerce data to <toType> and return object for new AEDesc */ 123 err = AECoercePtr(typeCode, 124 dataPtr, dataSize, 125 TclaeGetOSTypeFromObj(objv[kToType]), 126 toAEDescPtr); 127 128 ckfree(dataPtr); 129 130 if (err != noErr) { 131 ckfree((char *)toAEDescPtr); 132 Tcl_ResetResult(interp); 133 Tcl_AppendResult(interp, "Couldn't coerce |", 134 Tcl_GetString(objv[kData]), "| from '", 135 Tcl_GetString(objv[kTypeCode]), "' to '", 136 Tcl_GetString(objv[kToType]), "': ", 137 Tcl_MacOSError(interp, err), 138 (char *) NULL); 139 return TCL_ERROR; 140 } else { 141 Tcl_SetObjResult(interp, Tclae_NewAEDescObj(toAEDescPtr)); 142 return TCL_OK; 143 } 144} 145 146/* 147 * ------------------------------------------------------------------------- 148 * 149 * "Tclae_CoerceDescCmd" -- 150 * 151 * Tcl wrapper for ToolBox AECoerceDesc call. 152 * 153 * tclAE::coerceDesc <theAEDesc> <toType> 154 * 155 * Results: 156 * Tcl result code 157 * 158 * Side effects: 159 * result of interp is set to object for coerced AEDesc 160 * ------------------------------------------------------------------------- 161 */ 162int 163Tclae_CoerceDescCmd(ClientData clientData, /* (unused) */ 164 Tcl_Interp *interp, /* for results */ 165 int objc, /* number of arguments */ 166 Tcl_Obj *const objv[]) /* argument objects */ 167{ 168 OSErr err; /* result from ToolBox calls */ 169 int result; /* result from Tcl calls */ 170 const AEDesc * fromAEDescPtr; /* the original AEDesc */ 171 AEDesc * toAEDescPtr = NULL; /* pointer to coerced AEDesc */ 172 173 enum { 174 kAEDesc = 1, 175 kToType 176 }; 177 178 if (objc != 3) { 179 Tcl_WrongNumArgs(interp, 1, objv, "theAEDesc toType"); 180 return TCL_ERROR; 181 } 182 183 /* objv[1] holds original descriptor */ 184 result = Tclae_GetConstAEDescFromObj(interp, objv[kAEDesc], &fromAEDescPtr, true); 185 if (result != TCL_OK) { 186 return TCL_ERROR; 187 } 188 189 /* Allocate the coerced AEDesc */ 190 toAEDescPtr = (AEDesc *) ckalloc(sizeof(AEDesc)); 191 if (toAEDescPtr == NULL) { 192 return TCL_ERROR; 193 } 194 195 /* Coerce the AEDesc to the desired type */ 196 err = AECoerceDesc(fromAEDescPtr, 197 TclaeGetOSTypeFromObj(objv[kToType]), 198 toAEDescPtr); 199 200 if (err != noErr) { 201 ckfree((char *)toAEDescPtr); 202 Tcl_ResetResult(interp); 203 Tcl_AppendResult(interp, "Couldn't coerce descriptor to '", 204 Tcl_GetString(objv[kToType]), "': ", 205 Tcl_MacOSError(interp, err), 206 (char *) NULL); 207 return TCL_ERROR; 208 } else { 209 Tcl_SetObjResult(interp, Tclae_NewAEDescObj(toAEDescPtr)); 210 return TCL_OK; 211 } 212} 213 214/* 215 * ------------------------------------------------------------------------- 216 * 217 * "Tclae_CountItemsCmd" -- 218 * 219 * Tcl wrapper for ToolBox AECountItems call. 220 * 221 * tclAE::countItems <theAEDescList> 222 * 223 * Results: 224 * Tcl result code 225 * 226 * Side effects: 227 * result of interp is set to number of items 228 * ------------------------------------------------------------------------- 229 */ 230int 231Tclae_CountItemsCmd(ClientData clientData, /* (unused) */ 232 Tcl_Interp *interp, /* for results */ 233 int objc, /* number of arguments */ 234 Tcl_Obj *const objv[]) /* argument objects */ 235{ 236 OSErr err; /* result from ToolBox calls */ 237 int result; /* result from Tcl calls */ 238 long count; /* number of items in AEDescList */ 239 const AEDesc * theAEDescListPtr; /* pointer to AEDescList */ 240 241 242 if (objc != 2) { 243 Tcl_WrongNumArgs(interp, 1, objv, "theAEDescList"); 244 return TCL_ERROR; 245 } 246 247 /* Obtain AEDescList pointer from object */ 248 result = Tclae_GetConstAEDescFromObj(interp, objv[1], &theAEDescListPtr, true); 249 if (result != TCL_OK) { 250 return TCL_ERROR; 251 } 252 253 /* Count items in list (or return error if not a list) */ 254 err = AECountItems(theAEDescListPtr, &count); 255 if (err != noErr) { 256 Tcl_ResetResult(interp); 257 Tcl_AppendResult(interp, 258 "Couldn't count items in \"", 259 Tcl_GetString(objv[1]), "\": ", 260 Tcl_MacOSError(interp, err), 261 (char *) NULL); 262 return TCL_ERROR; 263 } 264 265 Tcl_SetObjResult(interp, Tcl_NewIntObj(count)); 266 267 return TCL_OK; 268} 269 270/* 271 * ------------------------------------------------------------------------- 272 * 273 * "Tclae_CreateDescCmd" -- 274 * 275 * Tcl wrapper for ToolBox AECreateDesc call. 276 * 277 * tclAE::createDesc <typeCode> ?data? 278 * 279 * Results: 280 * Tcl result code 281 * 282 * Side effects: 283 * result of interp is set to object for new AEDesc 284 * ------------------------------------------------------------------------- 285 */ 286int 287Tclae_CreateDescCmd(ClientData clientData, /* (unused) */ 288 Tcl_Interp *interp, /* for results */ 289 int objc, /* number of arguments */ 290 Tcl_Obj *const objv[]) /* argument objects */ 291{ 292 OSErr err; /* result from ToolBox calls */ 293 void* dataPtr = NULL; /* pointer to data */ 294 Size dataSize = 0; /* length of data */ 295 AEDesc* newAEDescPtr; /* pointer to new AEDesc */ 296 OSType typeCode; /* type of AEDesc to create */ 297 298 enum { 299 kTypeCode = 1, 300 kData 301 }; 302 303 if ((objc < 2) || (objc > 3)) { 304 Tcl_WrongNumArgs(interp, 1, objv, "typeCode ?data?"); 305 return TCL_ERROR; 306 } 307 308 typeCode = TclaeGetOSTypeFromObj(objv[kTypeCode]); 309 310 if (objc == 3) { 311 /* Extract <data> */ 312 dataPtr = TclaeDataFromObj(interp, typeCode, objv[kData], &dataSize); 313 314 if (!dataPtr) { 315 return TCL_ERROR; 316 } 317 } 318 319 /* create space for new AEDesc */ 320 newAEDescPtr = (AEDesc *) ckalloc(sizeof(AEDesc)); 321 if (newAEDescPtr == NULL) { 322 ckfree(dataPtr); 323 return TCL_ERROR; 324 } 325 326 /* Create an empty AEDesc with of type <typeCode> */ 327 err = AECreateDesc(typeCode, dataPtr, dataSize, newAEDescPtr); 328 329 ckfree(dataPtr); 330 331 if (err != noErr) { 332 ckfree((char *)newAEDescPtr); 333 Tcl_ResetResult(interp); 334 Tcl_AppendResult(interp, "Couldn't create descriptor: ", 335 Tcl_MacOSError(interp, err), 336 (char *) NULL); 337 return TCL_ERROR; 338 } else { 339 /* Set interp's result to a object to newAEDescPtr */ 340 Tcl_SetObjResult(interp, Tclae_NewAEDescObj(newAEDescPtr)); 341 342 return TCL_OK; 343 } 344} 345 346/* 347 * ------------------------------------------------------------------------- 348 * 349 * "Tclae_CreateListCmd" -- 350 * 351 * Tcl wrapper for ToolBox AECreateList call. 352 * 353 * tclAE::createList ?isRecord? 354 * 355 * Results: 356 * Tcl result code 357 * 358 * Side effects: 359 * result of interp is set to object for new AEDescList 360 * ------------------------------------------------------------------------- 361 */ 362int 363Tclae_CreateListCmd(ClientData clientData, /* (unused) */ 364 Tcl_Interp *interp, /* for results */ 365 int objc, /* number of arguments */ 366 Tcl_Obj *const objv[]) /* argument objects */ 367{ 368 OSErr err; /* result from ToolBox calls */ 369 AEDescList * newAEDescListPtr; /* pointer to new AEDescList */ 370 int isRecord = false; /* flag for AERecord or AEDescList */ 371 372 if ((objc < 1) || (objc > 2)) { 373 Tcl_WrongNumArgs(interp, 1, objv, "?isRecord?"); 374 return TCL_ERROR; 375 } 376 377 if (objc == 2) { 378 int result; 379 380 /* Read flag for whether to create AERecord or AEDescList */ 381 result = Tcl_GetBooleanFromObj(interp, objv[1], &isRecord); 382 if (result != TCL_OK) { 383 return TCL_ERROR; 384 } 385 } 386 387 /* Allocate space for new AEDescList */ 388 newAEDescListPtr = (AEDescList *) ckalloc(sizeof(AEDescList)); 389 if (newAEDescListPtr == NULL) { 390 return TCL_ERROR; 391 } 392 393 /* 394 * AECreateDesc() wants a Boolean (unsigned char), but Tcl_GetBooleanFromObj() 395 * takes the address of an integer. (sigh) 396 */ 397 err = AECreateList(NULL, 0, (Boolean) isRecord, newAEDescListPtr); 398 if (err != noErr) { 399 ckfree((char *)newAEDescListPtr); 400 Tcl_ResetResult(interp); 401 Tcl_AppendResult(interp, "Couldn't create AEDescList: ", 402 Tcl_MacOSError(interp, err), 403 (char *) NULL); 404 405 return TCL_ERROR; 406 } else { 407 /* Set interp's result to a object to newAEDescListPtr */ 408 Tcl_SetObjResult(interp, Tclae_NewAEDescObj(newAEDescListPtr)); 409 410 return TCL_OK; 411 } 412} 413 414/* 415 * ------------------------------------------------------------------------- 416 * 417 * "Tclae_DeleteItemCmd" -- 418 * 419 * Tcl wrapper for ToolBox AEDeleteItem call 420 * 421 * tclAE::deleteItem <theAEDescList> <item> 422 * 423 * Results: 424 * Tcl result code 425 * 426 * Side effects: 427 * Item is deleted from AEDescList 428 * ------------------------------------------------------------------------- 429 */ 430int 431Tclae_DeleteItemCmd(ClientData clientData, /* (unused) */ 432 Tcl_Interp *interp, /* for results */ 433 int objc, /* number of arguments */ 434 Tcl_Obj *const objv[]) /* argument objects */ 435{ 436 OSErr err; /* result from ToolBox calls */ 437 int result; /* result from Tcl calls */ 438 AEDesc *theAEDescListPtr; /* pointer to AEDescList */ 439 int index; /* index of item to delete */ 440 441 442 if (objc != 3) { 443 Tcl_WrongNumArgs(interp, 1, objv, "theAEDescList item"); 444 return TCL_ERROR; 445 } 446 447 /* Obtain AEDescList pointer from object */ 448 result = Tclae_GetAEDescFromObj(interp, objv[1], &theAEDescListPtr, true); 449 if (result != TCL_OK) { 450 return TCL_ERROR; 451 } 452 453 /* Read index of item to delete */ 454 result = Tcl_GetIntFromObj(interp, objv[2], &index); 455 if (result != TCL_OK) { 456 return TCL_ERROR; 457 } 458 459 /* Delete nth item 460 * Tcl is 0-based, but AEDescLists are 1-based. 461 */ 462 err = AEDeleteItem(theAEDescListPtr, index + 1); 463 if (err != noErr) { 464 Tcl_ResetResult(interp); 465 Tcl_AppendResult(interp, 466 "Couldn't delete item from \"", 467 Tcl_GetString(objv[1]), "\": ", 468 Tcl_MacOSError(interp, err), 469 (char *) NULL); 470 return TCL_ERROR; 471 } else { 472 Tcl_InvalidateStringRep(objv[1]); 473 Tcl_SetObjResult(interp, objv[1]); 474 return TCL_OK; 475 } 476} 477 478/* 479 * ------------------------------------------------------------------------- 480 * 481 * "Tclae_DeleteKeyDescCmd" -- 482 * 483 * Tcl wrapper for ToolBox AEDeleteKeyDesc call 484 * 485 * tclAE::deleteItem <theAERecord> <theAEKeyword> 486 * 487 * Results: 488 * Tcl result code 489 * 490 * Side effects: 491 * Key item is deleted from AERecord 492 * ------------------------------------------------------------------------- 493 */ 494int 495Tclae_DeleteKeyDescCmd(ClientData clientData, /* (unused) */ 496 Tcl_Interp *interp, /* for results */ 497 int objc, /* number of arguments */ 498 Tcl_Obj *const objv[]) /* argument objects */ 499{ 500 OSErr err; /* result from ToolBox calls */ 501 int result; /* result from Tcl calls */ 502 AERecord *theAERecordPtr; /* pointer to AERecord */ 503 504 505 if (objc != 3) { 506 Tcl_WrongNumArgs(interp, 1, objv, "theAERecord theAEKeyword"); 507 return TCL_ERROR; 508 } 509 510 /* Obtain AERecord pointer from object */ 511 result = Tclae_GetAEDescFromObj(interp, objv[1], &theAERecordPtr, true); 512 if (result != TCL_OK) { 513 return TCL_ERROR; 514 } 515 516 /* Delete the key item */ 517 err = AEDeleteKeyDesc(theAERecordPtr, TclaeGetOSTypeFromObj(objv[2])); 518 if (err != noErr) { 519 Tcl_ResetResult(interp); 520 Tcl_AppendResult(interp, "Couldn't delete keyword '", 521 Tcl_GetString(objv[2]), "' from \"", 522 Tcl_GetString(objv[1]), "\": ", 523 Tcl_MacOSError(interp, err), 524 (char *) NULL); 525 return TCL_ERROR; 526 } 527 528 return TCL_OK; 529} 530 531/* 532 * ------------------------------------------------------------------------- 533 * 534 * "Tclae_DisposeDescCmd" -- 535 * 536 * Tcl wrapper for ToolBox AEDisposeDesc call 537 * 538 * tclAE::disposeDesc <theAEDesc> 539 * 540 * Results: 541 * Tcl result code 542 * 543 * Side effects: 544 * Descriptor is deleted 545 * ------------------------------------------------------------------------- 546 */ 547int 548Tclae_DisposeDescCmd(ClientData clientData, /* (unused) */ 549 Tcl_Interp *interp, /* for results */ 550 int objc, /* number of arguments */ 551 Tcl_Obj *const objv[]) /* argument objects */ 552{ 553 if (objc != 2) { 554 Tcl_WrongNumArgs(interp, 1, objv, "theAEDesc"); 555 return TCL_ERROR; 556 } 557 558 Tcl_DecrRefCount(objv[1]); 559 560 return TCL_OK; 561} 562 563/* 564 * ------------------------------------------------------------------------- 565 * 566 * "Tclae_DuplicateDescCmd" -- 567 * 568 * Tcl wrapper for ToolBox AEDuplicateDesc call 569 * 570 * tclAE::duplicateDesc <theAEDesc> 571 * 572 * Results: 573 * Tcl result code 574 * 575 * Side effects: 576 * result of interp is set to object for duplicate AEDesc 577 * ------------------------------------------------------------------------- 578 */ 579int 580Tclae_DuplicateDescCmd(ClientData clientData, /* (unused) */ 581 Tcl_Interp *interp, /* for results */ 582 int objc, /* number of arguments */ 583 Tcl_Obj *const objv[]) /* argument objects */ 584{ 585 OSErr err; /* result from ToolBox calls */ 586 int result; /* result from Tcl calls */ 587 const AEDesc * oldAEDescPtr; /* pointer to old AEDesc */ 588 AEDesc * newAEDescPtr; /* pointer to new AEDesc */ 589 590 enum { 591 kAEDesc = 1 592 }; 593 594 if (objc < 2) { 595 Tcl_WrongNumArgs(interp, 1, objv, "theAEDesc"); 596 return TCL_ERROR; 597 } 598 599 /* Obtain AEDesc from object */ 600 result = Tclae_GetConstAEDescFromObj(interp, objv[kAEDesc], &oldAEDescPtr, true); 601 if (result != TCL_OK) { 602 return TCL_ERROR; 603 } 604 605 newAEDescPtr = (AEDesc *) ckalloc(sizeof(AEDesc)); 606 if (newAEDescPtr) { 607 err = AEDuplicateDesc(oldAEDescPtr, newAEDescPtr); 608 if (err != noErr) { 609 Tcl_ResetResult(interp); 610 Tcl_AppendResult(interp, "Couldn't duplicate \"", 611 Tcl_GetString(objv[kAEDesc]), "\": ", 612 Tcl_MacOSError(interp, err), 613 (char *) NULL); 614 ckfree((char *) newAEDescPtr); 615 return TCL_ERROR; 616 } else { 617 /* Set interp's result to object of newAEDescPtr */ 618 Tcl_SetObjResult(interp, Tclae_NewAEDescObj(newAEDescPtr)); 619 620 return TCL_OK; 621 } 622 } else { 623 return TCL_ERROR; 624 } 625} 626 627/* 628 * ------------------------------------------------------------------------- 629 * 630 * "Tclae_GetAttributeDataCmd" -- 631 * 632 * Tcl emulator for ToolBox AEGetAttributePtr call 633 * 634 * tclAE::getAttributeData <theAppleEvent> <theAEKeyword> ?desiredType? ?typeCodePtr? 635 * 636 * Results: 637 * Tcl result code 638 * 639 * Side effects: 640 * result of interp is set to text representation of AppleEvent attribute item 641 * ------------------------------------------------------------------------- 642 */ 643int 644Tclae_GetAttributeDataCmd(ClientData clientData, /* (unused) */ 645 Tcl_Interp *interp, /* for results */ 646 int objc, /* number of arguments */ 647 Tcl_Obj *const objv[]) /* argument objects */ 648{ 649 int result; /* result from Tcl calls */ 650 CmdReturn * returnStructPtr; /* result from internal calls */ 651 AEDesc tempAEDesc; /* temporary AEDesc from record */ 652 Tcl_Obj * desiredTypePtr = NULL; /* optional type to cast AEDesc to */ 653 Tcl_Obj * typeCodeVarPtr = NULL; /* optional name of type code variable */ 654 655 656 if ((objc < 3) || (objc > 5)) { 657 Tcl_WrongNumArgs(interp, 1, objv, "theAppleEvent theAEKeyword ?desiredType? ?typeCodePtr?"); 658 return TCL_ERROR; 659 } 660 661 if (objc > 3) { 662 desiredTypePtr = objv[3]; 663 if (objc > 4) { 664 /* Optional Tcl variable to store (coerced) AEDesc type */ 665 typeCodeVarPtr = objv[4]; 666 } 667 } 668 669 /* objv[1] holds AppleEvent object */ 670 /* objv[2] holds attribute keyword */ 671 result = TclaeGetAttributeDesc(interp, objv[1], objv[2], 672 NULL, &tempAEDesc); 673 if (result != TCL_OK) { 674 return TCL_ERROR; 675 } 676 677 /* Obtain data from AEDesc */ 678 returnStructPtr = TclaeDataFromAEDesc(interp, &tempAEDesc, 679 desiredTypePtr, typeCodeVarPtr); 680 AEDisposeDesc(&tempAEDesc); 681 682 if (returnStructPtr->object != NULL) { 683 Tcl_SetObjResult(interp, returnStructPtr->object); 684 } 685 result = returnStructPtr->status; 686 ckfree((char *)returnStructPtr); 687 688 return result; 689} 690 691/* 692 * ------------------------------------------------------------------------- 693 * 694 * "Tclae_GetAttributeDescCmd" -- 695 * 696 * Tcl wrapper for ToolBox AEGetAttributeDesc call 697 * 698 * tclAE::getKeyDesc <theAppleEvent> <theAEKeyword> ?desiredType? 699 * 700 * Results: 701 * Tcl result code 702 * 703 * Side effects: 704 * result of interp is set to object for key item 705 * ------------------------------------------------------------------------- 706 */ 707int 708Tclae_GetAttributeDescCmd(ClientData clientData, /* (unused) */ 709 Tcl_Interp *interp, /* for results */ 710 int objc, /* number of arguments */ 711 Tcl_Obj *const objv[]) /* argument objects */ 712{ 713 int result; /* result from Tcl calls */ 714 AEDesc * theAEDescPtr; /* pointer to new AEDesc */ 715 Tcl_Obj * desiredTypePtr = NULL; /* optional type to cast AEDesc to */ 716 717 718 if ((objc < 3) || (objc > 4)) { 719 Tcl_WrongNumArgs(interp, 1, objv, "theAppleEvent theAEKeyword ?desiredType?"); 720 return TCL_ERROR; 721 } 722 723 if (objc > 3) { 724 desiredTypePtr = objv[3]; 725 } 726 /* Allocate space for new AEDesc */ 727 theAEDescPtr = (AEDesc *) ckalloc(sizeof(AEDesc)); 728 if (theAEDescPtr == NULL) { 729 return TCL_ERROR; 730 } 731 732 /* objv[1] holds AppleEvent object */ 733 /* objv[2] holds attribute keyword */ 734 result = TclaeGetAttributeDesc(interp, objv[1], objv[2], 735 desiredTypePtr, theAEDescPtr); 736 if (result == TCL_OK) { 737 /* Set interp's result to a reference to theAEDescPtr */ 738 Tcl_SetObjResult(interp, Tclae_NewAEDescObj(theAEDescPtr)); 739 740 return TCL_OK; 741 } else { 742 ckfree((char *)theAEDescPtr); 743 return TCL_ERROR; 744 } 745} 746 747/* 748 * ------------------------------------------------------------------------- 749 * 750 * "Tclae_GetDataCmd" -- 751 * 752 * Tcl access for theAEDesc.dataHandle 753 * 754 * tclAE::getData <theAEDesc> ?desiredType? ?typeCodePtr? 755 * 756 * Results: 757 * Tcl result code 758 * 759 * Side effects: 760 * result of interp is set to text representation of AEDesc 761 * ------------------------------------------------------------------------- 762 */ 763int 764Tclae_GetDataCmd(ClientData clientData, /* (unused) */ 765 Tcl_Interp *interp, /* for results */ 766 int objc, /* number of arguments */ 767 Tcl_Obj *const objv[]) /* argument objects */ 768{ 769 int result; /* result from Tcl calls */ 770 CmdReturn * returnStructPtr; /* result from internal calls */ 771 const AEDesc * theAEDescPtr; /* pointer to new AEDesc */ 772 Tcl_Obj * typeCodeVarPtr = NULL; /* optional name of type code variable */ 773 Tcl_Obj * desiredTypePtr = NULL; /* optional type to cast AEDesc to */ 774 775 776 if ((objc < 2) || (objc > 4)) { 777 Tcl_WrongNumArgs(interp, 1, objv, "theAEDesc ?desiredType? ?typeCodePtr?"); 778 return TCL_ERROR; 779 } 780 781 result = Tclae_GetConstAEDescFromObj(interp, objv[1], &theAEDescPtr, true); 782 if (result != TCL_OK) { 783 return TCL_ERROR; 784 } 785 786 if (objc > 2) { 787 /* Optional desired type */ 788 desiredTypePtr = objv[2]; 789 if (objc > 3) { 790 /* Optional Tcl variable to store (coerced) AEDesc type */ 791 typeCodeVarPtr = objv[3]; 792 } 793 } 794 795 /* Obtain (optionally coerced) data from AEDesc */ 796 returnStructPtr = TclaeDataFromAEDesc(interp, theAEDescPtr, 797 desiredTypePtr, typeCodeVarPtr); 798 799 if (returnStructPtr->object != NULL) { 800 Tcl_SetObjResult(interp, returnStructPtr->object); 801 } 802 result = returnStructPtr->status; 803 ckfree((char *)returnStructPtr); 804 805 return result; 806} 807 808/* 809 * ------------------------------------------------------------------------- 810 * 811 * "Tclae_GetDescTypeCmd" -- 812 * 813 * Tcl access for theAEDesc.descriptorType 814 * 815 * tclAE::getDescType <theAEDesc> 816 * 817 * Results: 818 * Tcl result code 819 * 820 * Side effects: 821 * result of interp is set to DescType of AEDesc 822 * ------------------------------------------------------------------------- 823 */ 824int 825Tclae_GetDescTypeCmd(ClientData clientData, /* (unused) */ 826 Tcl_Interp *interp, /* for results */ 827 int objc, /* number of arguments */ 828 Tcl_Obj *const objv[]) /* argument objects */ 829{ 830 int result; /* result from Tcl calls */ 831 const AEDesc * theAEDescPtr; /* pointer to AEDesc */ 832 833 834 if (objc != 2) { 835 Tcl_WrongNumArgs(interp, 1, objv, "theAEDesc"); 836 return TCL_ERROR; 837 } 838 839 result = Tclae_GetConstAEDescFromObj(interp,objv[1], &theAEDescPtr, true); 840 if (result != TCL_OK) { 841 return TCL_ERROR; 842 } 843 844 /* Convert descriptor type to UTF and place in interp result */ 845 Tcl_SetObjResult(interp, TclaeNewOSTypeObj(theAEDescPtr->descriptorType)); 846 847 return TCL_OK; 848} 849 850/* 851 * ------------------------------------------------------------------------- 852 * 853 * "Tclae_GetKeyDataCmd" -- 854 * 855 * Tcl emulator for ToolBox AEGetKeyPtr call 856 * 857 * tclAE::getKeyData <theAERecord> <theAEKeyword> ?desiredType? ?typeCodePtr? 858 * 859 * Results: 860 * Tcl result code 861 * 862 * Side effects: 863 * result of interp is set to text representation of AERecord key item 864 * ------------------------------------------------------------------------- 865 */ 866int 867Tclae_GetKeyDataCmd(ClientData clientData, /* (unused) */ 868 Tcl_Interp *interp, /* for results */ 869 int objc, /* number of arguments */ 870 Tcl_Obj *const objv[]) /* argument objects */ 871{ 872 int result; /* result from Tcl calls */ 873 CmdReturn *returnStructPtr; /* result from internal calls */ 874 AEDesc tempAEDesc; /* temporary AEDesc from record */ 875 Tcl_Obj *desiredTypePtr = NULL; /* optional type to cast AEDesc to */ 876 Tcl_Obj *typeCodeVarPtr = NULL; /* optional name of type code variable */ 877 878 879 if ((objc < 3) || (objc > 5)) { 880 Tcl_WrongNumArgs(interp, 1, objv, "theAERecord theAEKeyword ?desiredType? ?typeCodePtr?"); 881 return TCL_ERROR; 882 } 883 884 if (objc > 3) { 885 desiredTypePtr = objv[3]; 886 if (objc > 4) { 887 /* Optional Tcl variable to store (coerced) AEDesc type */ 888 typeCodeVarPtr = objv[4]; 889 } 890 } 891 892 /* objv[1] holds AERecord object */ 893 /* objv[2] holds AEKeyword */ 894 result = TclaeGetKeyDesc(interp, objv[1], objv[2], 895 NULL, &tempAEDesc); 896 if (result != TCL_OK) { 897 return TCL_ERROR; 898 } 899 900 /* Obtain data from AEDesc */ 901 returnStructPtr = TclaeDataFromAEDesc(interp, &tempAEDesc, 902 desiredTypePtr, typeCodeVarPtr); 903 AEDisposeDesc(&tempAEDesc); 904 905 if (returnStructPtr->object != NULL) { 906 Tcl_SetObjResult(interp, returnStructPtr->object); 907 } 908 result = returnStructPtr->status; 909 ckfree((char *)returnStructPtr); 910 911 return result; 912} 913 914/* 915 * ------------------------------------------------------------------------- 916 * 917 * "Tclae_GetKeyDescCmd" -- 918 * 919 * Tcl wrapper for ToolBox AEGetKeyDesc call 920 * 921 * tclAE::getKeyDesc <theAERecord> <theAEKeyword> ?desiredType? 922 * 923 * Results: 924 * Tcl result code 925 * 926 * Side effects: 927 * result of interp is set to object for key item 928 * ------------------------------------------------------------------------- 929 */ 930int 931Tclae_GetKeyDescCmd(ClientData clientData, /* (unused) */ 932 Tcl_Interp *interp, /* for results */ 933 int objc, /* number of arguments */ 934 Tcl_Obj *const objv[]) /* argument objects */ 935{ 936 int result; /* result from Tcl calls */ 937 AEDesc *theAEDescPtr; /* pointer to new AEDesc */ 938 Tcl_Obj *desiredTypePtr = NULL; /* optional type to cast AEDesc to */ 939 940 941 if ((objc < 3) || (objc > 4)) { 942 Tcl_WrongNumArgs(interp, 1, objv, "theAERecord theAEKeyword ?desiredType?"); 943 return TCL_ERROR; 944 } 945 946 if (objc > 3) { 947 desiredTypePtr = objv[3]; 948 } 949 /* Allocate space for new AEDesc */ 950 theAEDescPtr = (AEDesc *) ckalloc(sizeof(AEDesc)); 951 if (theAEDescPtr == NULL) { 952 return TCL_ERROR; 953 } 954 955 /* objv[1] holds AERecord object */ 956 /* objv[2] holds AEKeyword */ 957 result = TclaeGetKeyDesc(interp, objv[1], objv[2], 958 desiredTypePtr, theAEDescPtr); 959 if (result == TCL_OK) { 960 /* Set interp's result to a reference to theAEDescPtr */ 961 Tcl_SetObjResult(interp, Tclae_NewAEDescObj(theAEDescPtr)); 962 963 return TCL_OK; 964 } else { 965 ckfree((char *)theAEDescPtr); 966 return TCL_ERROR; 967 } 968} 969 970/* 971 * ------------------------------------------------------------------------- 972 * 973 * "Tclae_GetNthDataCmd" -- 974 * 975 * Tcl emulator for ToolBox AEGetNthPtr call 976 * 977 * tclAE::getNthData <theAEDescList> <index> ?desiredType? ?theAEKeywordPtr? ?typeCodePtr? 978 * 979 * Results: 980 * Tcl result code 981 * 982 * Side effects: 983 * result of interp is set to text representation of AEDescList item 984 * ------------------------------------------------------------------------- 985 */ 986int 987Tclae_GetNthDataCmd(ClientData clientData, /* (unused) */ 988 Tcl_Interp *interp, /* for results */ 989 int objc, /* number of arguments */ 990 Tcl_Obj *const objv[]) /* argument objects */ 991{ 992 int result; /* result from Tcl calls */ 993 CmdReturn * returnStructPtr; /* result from internal calls */ 994 AEDesc tempAEDesc; /* temporary AEDesc from list */ 995 Tcl_Obj * desiredTypePtr = NULL; /* optional type to cast 996 * AEDesc to */ 997 Tcl_Obj * keywordVarPtr = NULL; /* optional name of keyword 998 * variable (if from AERecord) */ 999 Tcl_Obj * typeCodeVarPtr = NULL; /* optional name of type code 1000 * variable */ 1001 1002 1003 if ((objc < 3) || (objc > 6)) { 1004 Tcl_WrongNumArgs(interp, 1, objv, "theAEDescList index ?desiredType? ?theAEKeywordPtr? ?typeCodePtr?"); 1005 return TCL_ERROR; 1006 } 1007 1008 if (objc > 3) { 1009 /* Optional desired type */ 1010 desiredTypePtr = objv[3]; 1011 if (objc > 4) { 1012 /* Optional Tcl variable to store keyword if item from AERecord */ 1013 keywordVarPtr = objv[4]; 1014 if (objc > 5) { 1015 /* Optional Tcl variable to store (coerced) AEDesc type */ 1016 typeCodeVarPtr = objv[5]; 1017 } 1018 } 1019 } 1020 1021 /* objv[1] holds AEDescList object */ 1022 /* objv[2] holds index */ 1023 result = TclaeGetNthDesc(interp, objv[1], objv[2], 1024 NULL, keywordVarPtr, &tempAEDesc); 1025 if (result != TCL_OK) { 1026 return TCL_ERROR; 1027 } 1028 1029 /* Obtain (optionally coerced) data from AEDesc */ 1030 returnStructPtr = TclaeDataFromAEDesc(interp, &tempAEDesc, 1031 desiredTypePtr, typeCodeVarPtr); 1032 AEDisposeDesc(&tempAEDesc); 1033 1034 result = returnStructPtr->status; 1035 if (returnStructPtr->object != NULL) { 1036 /* Set interp's result to the data */ 1037 Tcl_SetObjResult(interp, returnStructPtr->object); 1038 } 1039 1040 ckfree((char *)returnStructPtr); 1041 1042 return result; 1043} 1044 1045/* 1046 * ------------------------------------------------------------------------- 1047 * 1048 * "Tclae_GetNthDescCmd" -- 1049 * 1050 * Tcl wrapper for ToolBox AEGetNthDesc call 1051 * 1052 * tclAE::getNthDesc <theAEDescList> <index> ?desiredType? ?theAEKeywordPtr? 1053 * 1054 * Results: 1055 * Tcl result code 1056 * 1057 * Side effects: 1058 * result of interp is set to object for nth AEDescList item 1059 * ------------------------------------------------------------------------- 1060 */ 1061int 1062Tclae_GetNthDescCmd(ClientData clientData, /* (unused) */ 1063 Tcl_Interp *interp, /* for results */ 1064 int objc, /* number of arguments */ 1065 Tcl_Obj *const objv[]) /* argument objects */ 1066{ 1067 int result; /* result from Tcl calls */ 1068 AEDesc *theAEDescPtr; /* pointer to new AEDesc */ 1069 Tcl_Obj *desiredTypePtr = NULL; /* optional type to cast 1070 * AEDesc to */ 1071 Tcl_Obj *keywordVarPtr = NULL; /* optional name of keyword 1072 * variable (if from AERecord) */ 1073 1074 1075 if ((objc < 3) || (objc > 5)) { 1076 Tcl_WrongNumArgs(interp, 1, objv, "theAEDescList index ?desiredType? ?theAEKeywordPtr?"); 1077 return TCL_ERROR; 1078 } 1079 1080 if (objc > 3) { 1081 /* Optional desired type */ 1082 desiredTypePtr = objv[3]; 1083 if (objc > 4) { 1084 /* Optional Tcl variable to store keyword if item from AERecord */ 1085 keywordVarPtr = objv[4]; 1086 } 1087 } 1088 1089 /* Allocate space for new AEDesc */ 1090 theAEDescPtr = (AEDesc *) ckalloc(sizeof(AEDesc)); 1091 if (theAEDescPtr == NULL) { 1092 return TCL_ERROR; 1093 } 1094 1095 /* objv[1] holds AEDescList object */ 1096 /* objv[2] holds index */ 1097 result = TclaeGetNthDesc(interp, objv[1], objv[2], 1098 desiredTypePtr, keywordVarPtr, theAEDescPtr); 1099 if (result == TCL_OK) { 1100 /* Set interp's result to a reference to theAEDescPtr */ 1101 Tcl_SetObjResult(interp, Tclae_NewAEDescObj(theAEDescPtr)); 1102 1103 return TCL_OK; 1104 } else { 1105 ckfree((char *)theAEDescPtr); 1106 return TCL_ERROR; 1107 } 1108} 1109 1110/* 1111 * ------------------------------------------------------------------------- 1112 * 1113 * "Tclae_PutDataCmd" -- 1114 * 1115 * Tcl wrapper for ToolBox AEPutPtr call 1116 * 1117 * tclAE::putData <theAEDescList> <index> <typeCode> <data> 1118 * 1119 * Results: 1120 * Tcl result code 1121 * 1122 * Side effects: 1123 * Item at index is replaced with data 1124 * Revised AEDescList is placed in interpreter's result 1125 * ------------------------------------------------------------------------- 1126 */ 1127int 1128Tclae_PutDataCmd(ClientData clientData, /* (unused) */ 1129 Tcl_Interp *interp, /* for results */ 1130 int objc, /* number of arguments */ 1131 Tcl_Obj *const objv[]) /* argument objects */ 1132{ 1133 OSErr err; /* result from ToolBox calls */ 1134 int result; /* result from Tcl calls */ 1135 void * dataPtr; /* pointer to data */ 1136 Size dataSize; /* length of data */ 1137 AEDescList * theAEDescListPtr; /* pointer to AEDescList */ 1138 int index; /* index of item to put */ 1139 OSType typeCode; /* type code of data */ 1140 1141 enum { 1142 kAEDescList = 1, 1143 kIndex, 1144 kTypeCode, 1145 kData 1146 }; 1147 1148 if (objc != 5) { 1149 Tcl_WrongNumArgs(interp, 1, objv, "theAEDescList index typeCode data"); 1150 return TCL_ERROR; 1151 } 1152 1153 result = Tclae_GetAEDescFromObj(interp, objv[kAEDescList], &theAEDescListPtr, true); 1154 if (result != TCL_OK) { 1155 return TCL_ERROR; 1156 } 1157 1158 /* Read index to obtain AEDesc from */ 1159 result = Tcl_GetIntFromObj(interp, objv[kIndex], &index); 1160 if (result != TCL_OK) { 1161 return TCL_ERROR; 1162 } 1163 1164 typeCode = TclaeGetOSTypeFromObj(objv[kTypeCode]); 1165 1166 /* Extract <data> */ 1167 dataPtr = TclaeDataFromObj(interp, typeCode, objv[kData], &dataSize); 1168 if (dataPtr == NULL) { 1169 return TCL_ERROR; 1170 } 1171 1172 /* Put data at index position in AEDescList. 1173 * Tcl is 0-based, but AEDescLists are 1-based. 1174 */ 1175 err = AEPutPtr(theAEDescListPtr, index + 1, 1176 typeCode, 1177 dataPtr, dataSize); 1178 1179 ckfree(dataPtr); 1180 1181 if (err != noErr) { 1182 Tcl_ResetResult(interp); 1183 Tcl_AppendResult(interp, "Couldn't put |", 1184 Tcl_GetString(objv[kData]), "| as '", 1185 Tcl_GetString(objv[kTypeCode]), "' into item #", 1186 Tcl_GetString(objv[kIndex]), " of \"", 1187 Tcl_GetString(objv[kAEDescList]), "\": ", 1188 Tcl_MacOSError(interp, err), 1189 (char *) NULL); 1190 return TCL_ERROR; 1191 } else { 1192 Tcl_InvalidateStringRep(objv[kAEDescList]); 1193 Tcl_SetObjResult(interp, objv[kAEDescList]); 1194 return TCL_OK; 1195 } 1196} 1197 1198/* 1199 * ------------------------------------------------------------------------- 1200 * 1201 * "Tclae_PutDescCmd" -- 1202 * 1203 * Tcl wrapper for ToolBox AEPutDesc call 1204 * 1205 * tclAE::putDesc <theAEDescList> <index> <theAEDesc> 1206 * 1207 * Results: 1208 * Tcl result code 1209 * 1210 * Side effects: 1211 * Item at index is replaced with theAEDesc 1212 * Revised AEDescList is placed in interpreter's result 1213 * ------------------------------------------------------------------------- 1214 */ 1215int 1216Tclae_PutDescCmd(ClientData clientData, /* (unused) */ 1217 Tcl_Interp *interp, /* for results */ 1218 int objc, /* number of arguments */ 1219 Tcl_Obj *const objv[]) /* argument objects */ 1220{ 1221 OSErr err; /* result from ToolBox calls */ 1222 int result; /* result from Tcl calls */ 1223 const AEDesc * theAEDescPtr; /* AEDesc to put in AEDescList */ 1224 AEDescList * theAEDescListPtr; /* pointer to AEDescList */ 1225 int index; /* index of item to put */ 1226 1227 enum { 1228 kAEDescList = 1, 1229 kIndex, 1230 kAEDesc 1231 }; 1232 1233 if (objc < 4) { 1234 Tcl_WrongNumArgs(interp, 1, objv, "theAEDescList index theAEDesc"); 1235 return TCL_ERROR; 1236 } 1237 1238 result = Tclae_GetAEDescFromObj(interp, objv[kAEDescList], &theAEDescListPtr, true); 1239 if (result != TCL_OK) { 1240 return TCL_ERROR; 1241 } 1242 1243 /* Read index to obtain AEDesc from */ 1244 result = Tcl_GetIntFromObj(interp, objv[kIndex], &index); 1245 if (result != TCL_OK) { 1246 return TCL_ERROR; 1247 } 1248 1249 /* objv[kAEDesc] holds AEDesc object */ 1250 result = Tclae_GetConstAEDescFromObj(interp, objv[kAEDesc], &theAEDescPtr, true); 1251 if (result != TCL_OK) { 1252 return TCL_ERROR; 1253 } 1254 1255 /* Put new AEDesc at index position in AEDescList. 1256 * Tcl is 0-based, but AEDescLists are 1-based. 1257 */ 1258 err = AEPutDesc(theAEDescListPtr, index + 1, theAEDescPtr); 1259 1260 if (err != noErr) { 1261 Tcl_ResetResult(interp); 1262 Tcl_AppendResult(interp, "Couldn't put \"", 1263 Tcl_GetString(objv[kAEDesc]), "\" into item #", 1264 Tcl_GetString(objv[kIndex]), " of \"", 1265 Tcl_GetString(objv[kAEDescList]), "\": ", 1266 Tcl_MacOSError(interp, err), 1267 (char *) NULL); 1268 return TCL_ERROR; 1269 } else { 1270 Tcl_InvalidateStringRep(objv[kAEDescList]); 1271 Tcl_SetObjResult(interp, objv[kAEDescList]); 1272 return TCL_OK; 1273 } 1274} 1275 1276/* 1277 * ------------------------------------------------------------------------- 1278 * 1279 * "Tclae_PutKeyDataCmd" -- 1280 * 1281 * Tcl wrapper for ToolBox AEPutKeyPtr call 1282 * 1283 * tclAE::putKeyData <theAERecord> <theAEKeyword> <typeCode> <data> 1284 * 1285 * Results: 1286 * Tcl result code 1287 * 1288 * Side effects: 1289 * Key item is replaced with data 1290 * Revised AERecord is placed in interpreter's result 1291 * ------------------------------------------------------------------------- 1292 */ 1293int 1294Tclae_PutKeyDataCmd(ClientData clientData, /* (unused) */ 1295 Tcl_Interp *interp, /* for results */ 1296 int objc, /* number of arguments */ 1297 Tcl_Obj *const objv[]) /* argument objects */ 1298{ 1299 OSErr err; /* result from ToolBox calls */ 1300 int result; /* result from Tcl calls */ 1301 void * dataPtr; /* pointer to data */ 1302 Size dataSize; /* length of data */ 1303 AERecord * theAERecordPtr; /* pointer to AERecord */ 1304 OSType typeCode; /* type code of data */ 1305 1306 enum { 1307 kAERecord = 1, 1308 kAEKeyword, 1309 kTypeCode, 1310 kData 1311 }; 1312 1313 if (objc != 5) { 1314 Tcl_WrongNumArgs(interp, 1, objv, "theAERecord theAEKeyword typeCode data"); 1315 return TCL_ERROR; 1316 } 1317 1318 result = Tclae_GetAEDescFromObj(interp, objv[kAERecord], &theAERecordPtr, true); 1319 if (result != TCL_OK) { 1320 return TCL_ERROR; 1321 } 1322 1323 typeCode = TclaeGetOSTypeFromObj(objv[kTypeCode]); 1324 1325 /* Extract <data> */ 1326 dataPtr = TclaeDataFromObj(interp, typeCode, objv[kData], &dataSize); 1327 if (dataPtr == NULL) { 1328 return TCL_ERROR; 1329 } 1330 1331 /* Put new AEDesc into key entry of AERecord */ 1332 err = AEPutKeyPtr(theAERecordPtr, 1333 TclaeGetOSTypeFromObj(objv[kAEKeyword]), 1334 typeCode, 1335 dataPtr, dataSize); 1336 1337 ckfree(dataPtr); 1338 1339 if (err != noErr) { 1340 Tcl_ResetResult(interp); 1341 Tcl_AppendResult(interp, "Couldn't put |", 1342 Tcl_GetString(objv[kData]), "| as '", 1343 Tcl_GetString(objv[kTypeCode]), "' into key '", 1344 Tcl_GetString(objv[kAEKeyword]), "' of \"", 1345 Tcl_GetString(objv[kAERecord]), "\": ", 1346 Tcl_MacOSError(interp, err), 1347 (char *) NULL); 1348 return TCL_ERROR; 1349 } else { 1350 Tcl_InvalidateStringRep(objv[kAERecord]); 1351 Tcl_SetObjResult(interp, objv[kAERecord]); 1352 return TCL_OK; 1353 } 1354} 1355 1356/* 1357 * ------------------------------------------------------------------------- 1358 * 1359 * "Tclae_PutKeyDescCmd" -- 1360 * 1361 * Tcl wrapper for ToolBox AEPutKeyDesc call 1362 * 1363 * tclAE::putKeyDesc <theAERecord> <theAEKeyword> <theAEDesc> 1364 * 1365 * Results: 1366 * Tcl result code 1367 * 1368 * Side effects: 1369 * Key item is replaced with theAEDesc 1370 * Revised AERecord is placed in interpreter's result 1371 * ------------------------------------------------------------------------- 1372 */ 1373int 1374Tclae_PutKeyDescCmd(ClientData clientData, /* (unused) */ 1375 Tcl_Interp *interp, /* for results */ 1376 int objc, /* number of arguments */ 1377 Tcl_Obj *const objv[]) /* argument objects */ 1378{ 1379 OSErr err; /* result from ToolBox calls */ 1380 int result; /* result from Tcl calls */ 1381 const AEDesc * theAEDescPtr; /* AEDesc to put in AERecord */ 1382 AERecord * theAERecordPtr; /* pointer to AERecord */ 1383 1384 enum { 1385 kAERecord = 1, 1386 kAEKeyword, 1387 kAEDesc 1388 }; 1389 1390 if (objc < 4) { 1391 Tcl_WrongNumArgs(interp, 1, objv, "theAERecord theAEKeyword theAEDesc"); 1392 return TCL_ERROR; 1393 } 1394 1395 result = Tclae_GetAEDescFromObj(interp, objv[kAERecord], &theAERecordPtr, true); 1396 if (result != TCL_OK) { 1397 return TCL_ERROR; 1398 } 1399 1400 /* objv[kAEDesc] holds AEDesc object */ 1401 result = Tclae_GetConstAEDescFromObj(interp, objv[kAEDesc], &theAEDescPtr, true); 1402 if (result != TCL_OK) { 1403 return TCL_ERROR; 1404 } 1405 1406 /* Put new AEDesc into key entry of AERecord */ 1407 err = AEPutKeyDesc(theAERecordPtr, 1408 TclaeGetOSTypeFromObj(objv[kAEKeyword]), 1409 theAEDescPtr); 1410 1411 if (err != noErr) { 1412 Tcl_ResetResult(interp); 1413 Tcl_AppendResult(interp, "Couldn't put \"", 1414 Tcl_GetString(objv[kAEDesc]), "\" into key '", 1415 Tcl_GetString(objv[kAEKeyword]), "' of \"", 1416 Tcl_GetString(objv[kAERecord]), "\": ", 1417 Tcl_MacOSError(interp, err), 1418 (char *) NULL); 1419 return TCL_ERROR; 1420 } else { 1421 Tcl_InvalidateStringRep(objv[kAERecord]); 1422 Tcl_SetObjResult(interp, objv[kAERecord]); 1423 return TCL_OK; 1424 } 1425} 1426 1427/* 1428 * ------------------------------------------------------------------------- 1429 * 1430 * "Tclae_ReplaceDescDataCmd" -- 1431 * 1432 * Tcl wrapper for Carbon AEReplaceDescData call 1433 * and/or 1434 * Tcl access for theAEDesc.type and theAEDesc.dataHandle 1435 * 1436 * tclAE::replaceDescData <theAEDesc> <typeCode> <data> 1437 * 1438 * Results: 1439 * Tcl result code 1440 * 1441 * Side effects: 1442 * Revised AEDesc is placed in interpreter's result 1443 * ------------------------------------------------------------------------- 1444 */ 1445int 1446Tclae_ReplaceDescDataCmd(ClientData clientData, /* (unused) */ 1447 Tcl_Interp *interp, /* for results */ 1448 int objc, /* number of arguments */ 1449 Tcl_Obj *const objv[]) /* argument objects */ 1450{ 1451 OSErr err; /* result from ToolBox calls */ 1452 int result; /* result from Tcl calls */ 1453 AEDesc * theAEDescPtr; /* pointer to new AEDesc */ 1454 OSType typeCode; /* type code of data */ 1455 void * dataPtr; /* pointer to data */ 1456 Size dataSize; /* length of data */ 1457 1458 enum { 1459 kAEDesc = 1, 1460 kTypeCode, 1461 kData 1462 }; 1463 1464 if (objc != 4) { 1465 Tcl_WrongNumArgs(interp, 1, objv, "theAEDesc typeCode data"); 1466 return TCL_ERROR; 1467 } 1468 1469 1470 result = Tclae_GetAEDescFromObj(interp, objv[kAEDesc], &theAEDescPtr, true); 1471 if (result != TCL_OK) { 1472 return TCL_ERROR; 1473 } 1474 1475 typeCode = TclaeGetOSTypeFromObj(objv[kTypeCode]); 1476 1477 /* Extract <data> */ 1478 dataPtr = TclaeDataFromObj(interp, typeCode, objv[kData], &dataSize); 1479 if (dataPtr == NULL) { 1480 return TCL_ERROR; 1481 } 1482 1483#if ACCESSOR_CALLS_ARE_FUNCTIONS // das 25/10/00: Carbonization 1484 err = AEReplaceDescData(typeCode, dataPtr, dataSize, theAEDescPtr); 1485#else 1486 theAEDescPtr->descriptorType = typeCode; 1487 if (theAEDescPtr->dataHandle) { 1488 // Get rid of whatever was there before. 1489 // Can we depend on a non-NULL dataHandle being valid? If not, this is Bad�. 1490 1491 // das - 24 oct 2000 1492 // well it is Bad� indeed on the 68k, numerous AEDescs that this 1493 // routine comes across during a .test don't have a valid handle in 1494 // dataHandle (either NULL or not a handle at all, the latter is 1495 // most likely due to some other bug), this might be the same on 1496 // ppc, but the modern memory manager is probably more robust 1497 // against DisposeHandle on a invalid handle... on 68k this 1498 // crashes hard. 1499 1500 // das - 27 oct 2000 1501 // I've seen this only on CFM68k, and having looked into it more, 1502 // only when AEHandlers are involved, something funky must be going 1503 // on there 1504 1505 DisposeHandle(theAEDescPtr->dataHandle); 1506 } 1507 // !!! Can we depend on evaluation of Tcl_GetByteArrayFromObj() 1508 // before value of dataSize is set? 1509 err = PtrToHand(dataPtr, &theAEDescPtr->dataHandle, dataSize); 1510#endif 1511 1512 ckfree(dataPtr); 1513 1514 if (err != noErr) { 1515 Tcl_ResetResult(interp); 1516 Tcl_AppendResult(interp, "Couldn't set data of \"", 1517 Tcl_GetString(objv[kAEDesc]), "\" to |", 1518 Tcl_GetString(objv[kData]), "|: ", 1519 Tcl_MacOSError(interp, err), 1520 (char *) NULL); 1521 return TCL_ERROR; 1522 } else { 1523 Tcl_InvalidateStringRep(objv[kAEDesc]); 1524 Tcl_SetObjResult(interp, objv[kAEDesc]); 1525 return TCL_OK; 1526 } 1527} 1528 1529/* 1530 * ------------------------------------------------------------------------- 1531 * 1532 * "Tclae_SetDescTypeCmd" -- 1533 * 1534 * Tcl access for theAEDesc.descriptorType 1535 * 1536 * tclAE::desc::setDescType <theAEDesc> <toType> 1537 * 1538 * Results: 1539 * Tcl result code 1540 * 1541 * Side effects: 1542 * Type of AEDesc is changed to <toType> 1543 * Revised AEDesc is placed in interpreter's result 1544 * ------------------------------------------------------------------------- 1545 */ 1546int 1547Tclae_SetDescTypeCmd(ClientData clientData, /* (unused) */ 1548 Tcl_Interp *interp, /* for results */ 1549 int objc, /* number of arguments */ 1550 Tcl_Obj *const objv[]) /* argument objects */ 1551{ 1552 int result; /* result from Tcl calls */ 1553 AEDesc * theAEDescPtr; /* pointer to AEDesc */ 1554 1555 enum { 1556 kAEDesc = 1, 1557 kToType 1558 }; 1559 1560 if (objc != 3) { 1561 Tcl_WrongNumArgs(interp, 1, objv, "theAEDesc toType"); 1562 return TCL_ERROR; 1563 } 1564 1565 result = Tclae_GetAEDescFromObj(interp, objv[kAEDesc], &theAEDescPtr, true); 1566 if (result != TCL_OK) { 1567 return TCL_ERROR; 1568 } 1569 1570 theAEDescPtr->descriptorType = TclaeGetOSTypeFromObj(objv[kToType]); 1571 1572 Tcl_InvalidateStringRep(objv[kAEDesc]); 1573 Tcl_SetObjResult(interp, objv[kAEDesc]); 1574 1575 return TCL_OK; 1576} 1577 1578/* 1579 * ------------------------------------------------------------------------- 1580 * 1581 * "Tclae__GetAEDescCmd" -- 1582 * 1583 * Private call to retrieve the AEDesc pointer from the supplied AEDesc reference. 1584 * If you call this without my permission, I'll take away your birthday. 1585 * 1586 * tclAE::_private::_getAEDesc <theAEDesc> 1587 * 1588 * Results: 1589 * Tcl result code 1590 * 1591 * Side effects: 1592 * Result of interp is set to AEDesc * as ByteArray. 1593 * ------------------------------------------------------------------------- 1594 */ 1595int 1596Tclae__GetAEDescCmd(ClientData clientData, /* (unused) */ 1597 Tcl_Interp *interp, /* for results */ 1598 int objc, /* number of arguments */ 1599 Tcl_Obj *const objv[]) /* argument objects */ 1600{ 1601 const AEDesc * theAEDescPtr; /* pointer to AEDesc */ 1602 int result; 1603 1604 enum { 1605 kAEDesc = 1 1606 }; 1607 1608 if (objc != 2) { 1609 Tcl_WrongNumArgs(interp, 1, objv, "theAEDesc"); 1610 return TCL_ERROR; 1611 } 1612 1613 result = Tclae_GetConstAEDescFromObj(interp, objv[kAEDesc], &theAEDescPtr, true); 1614 if (result != TCL_OK) { 1615 return TCL_ERROR; 1616 } 1617 1618 Tcl_SetObjResult(interp, 1619 Tcl_NewByteArrayObj((unsigned char *) &theAEDescPtr, 1620 sizeof(theAEDescPtr))); 1621 1622 return TCL_OK; 1623} 1624 1625/* ���� Internal package routines ���� */ 1626 1627/* 1628 * ------------------------------------------------------------------------- 1629 * 1630 * "TclaeDataFromObj" -- 1631 * 1632 * Extract data from supplied object. 1633 * If byte array, return it raw, else, perform UtfToExternal conversion 1634 * on string before returning it. 1635 * 1636 * !!! Caller is responsible for disposing of data pointer !!! 1637 * 1638 * Results: 1639 * pointer to data 1640 * 1641 * Side effects: 1642 * Contents of dataSizePtr (if non-NULL) is set to the data length 1643 * ------------------------------------------------------------------------- 1644 */ 1645void * 1646TclaeDataFromObj(Tcl_Interp* interp, /* for error reporting */ 1647 OSType typeCode, /* purported typecode of data */ 1648 Tcl_Obj* dataObjPtr, /* object holding desired data */ 1649 Size* dataSizePtr) /* pointer to hold length of data */ 1650{ 1651 void* dataPtr; 1652 void* tempPtr; 1653 int dataSize; 1654 1655 1656 if (dataObjPtr->typePtr == Tcl_GetObjType("bytearray")) { // das 25/09/00 1657 tempPtr = Tcl_GetByteArrayFromObj(dataObjPtr, &dataSize); 1658 1659 dataPtr = ckalloc(dataSize); 1660 if (dataPtr) { 1661 memcpy(dataPtr, tempPtr, dataSize); 1662 } 1663 } else { 1664 switch (typeCode) { 1665#if TARGET_API_MAC_CARBON 1666 case typeUnicodeText: 1667 tempPtr = Tcl_GetUnicodeFromObj(dataObjPtr, &dataSize); 1668 dataSize *= sizeof(Tcl_UniChar); 1669 dataPtr = ckalloc(dataSize); 1670 if (dataPtr) { 1671 memcpy(dataPtr, tempPtr, dataSize); 1672 } 1673 break; 1674 case typeUTF8Text: 1675 tempPtr = Tcl_GetStringFromObj(dataObjPtr, &dataSize); 1676 dataPtr = ckalloc(dataSize); 1677 if (dataPtr) { 1678 memcpy(dataPtr, tempPtr, dataSize); 1679 } 1680 break; 1681#endif // TARGET_API_MAC_CARBON 1682 default: { 1683 Tcl_DString dataDS; /* for conversion from UTF */ 1684 1685 /* Convert data from UTF */ 1686 Tcl_UtfToExternalDString(tclAE_macRoman_encoding, Tcl_GetString(dataObjPtr), -1, &dataDS); 1687 1688 dataSize = Tcl_DStringLength(&dataDS); 1689 dataPtr = ckalloc(dataSize); 1690 if (dataPtr) { 1691 memcpy(dataPtr, Tcl_DStringValue(&dataDS), dataSize); 1692 } 1693 1694 Tcl_DStringFree(&dataDS); 1695 } 1696 } 1697 } 1698 1699 if (dataPtr && dataSizePtr) { 1700 *dataSizePtr = dataSize; 1701 } 1702 1703 return dataPtr; 1704} 1705 1706/* 1707 * ------------------------------------------------------------------------- 1708 * 1709 * "TclaeGetAttributeDesc" -- 1710 * 1711 * Derive an AE descriptor from the supplied AppleEvent object and 1712 * AEKeyword. 1713 * 1714 * Results: 1715 * Tcl result code 1716 * 1717 * Side effects: 1718 * keyAEDescPtr points to (optionally coerced) AEDesc from AppleEvent key. 1719 * keyAEDescPtr must already exist! 1720 * ------------------------------------------------------------------------- 1721 */ 1722int 1723TclaeGetAttributeDesc(Tcl_Interp *interp, /* for results */ 1724 Tcl_Obj *theAppleEventObjPtr, /* the AppleEvent */ 1725 Tcl_Obj *theAttributeObjPtr, /* attribute to retrieve */ 1726 Tcl_Obj *theDesiredTypeObjPtr, /* (optional) desired type */ 1727 AEDesc *keyAEDescPtr) /* pointer to new AEDesc from key */ 1728{ 1729 OSErr err; /* result from ToolBox calls */ 1730 int result; /* result from Tcl calls */ 1731 const AppleEvent * theAppleEventPtr; /* pointer to AppleEvent */ 1732 DescType desiredType = typeWildCard; /* optional type for new AEDesc */ 1733 1734 /* Obtain AppleEvent pointer from reference */ 1735 result = Tclae_GetConstAEDescFromObj(interp, theAppleEventObjPtr, &theAppleEventPtr, true); 1736 if (result != TCL_OK) { 1737 return TCL_ERROR; 1738 } 1739 1740 if (theDesiredTypeObjPtr != NULL) { 1741 /* Optional desired type */ 1742 desiredType = TclaeGetOSTypeFromObj(theDesiredTypeObjPtr); 1743 } 1744 1745 /* Get key item */ 1746 err = AEGetAttributeDesc(theAppleEventPtr, 1747 TclaeGetOSTypeFromObj(theAttributeObjPtr), 1748 desiredType, 1749 keyAEDescPtr); 1750 if (err != noErr) { 1751 Tcl_ResetResult(interp); 1752 Tcl_AppendResult(interp, "Couldn't get attribute '", 1753 Tcl_GetString(theAttributeObjPtr), "' from \"", 1754 Tcl_GetString(theAppleEventObjPtr), "\": ", 1755 Tcl_MacOSError(interp, err), 1756 (char *) NULL); 1757 return TCL_ERROR; 1758 } 1759 1760 return TCL_OK; 1761} 1762 1763/* 1764 * ------------------------------------------------------------------------- 1765 * 1766 * "TclaeGetKeyDesc" -- 1767 * 1768 * Derive an AE descriptor from the supplied AERecord object and 1769 * AEKeyword. 1770 * 1771 * Results: 1772 * Tcl result code 1773 * 1774 * Side effects: 1775 * keyAEDescPtr points to (optionally coerced) AEDesc from AERecord key. 1776 * keyAEDescPtr must already exist! 1777 * ------------------------------------------------------------------------- 1778 */ 1779int 1780TclaeGetKeyDesc(Tcl_Interp *interp, /* for results */ 1781 Tcl_Obj *theAERecordObjPtr, /* the AERecord */ 1782 Tcl_Obj *theAEKeywordObjPtr, /* keyword item to retrieve */ 1783 Tcl_Obj *theDesiredTypeObjPtr, /* (optional) desired type */ 1784 AEDesc *keyAEDescPtr) /* pointer to new AEDesc from key */ 1785{ 1786 OSErr err; /* result from ToolBox calls */ 1787 int result; /* result from Tcl calls */ 1788 const AERecord * theAERecordPtr; /* pointer to AERecord */ 1789 DescType desiredType = typeWildCard; /* optional type for new AEDesc */ 1790 1791 /* Obtain AERecord pointer from reference */ 1792 result = Tclae_GetConstAEDescFromObj(interp, theAERecordObjPtr, &theAERecordPtr, true); 1793 if (result != TCL_OK) { 1794 return TCL_ERROR; 1795 } 1796 1797 if (theDesiredTypeObjPtr != NULL) { 1798 /* Optional desired type */ 1799 desiredType = TclaeGetOSTypeFromObj(theDesiredTypeObjPtr); 1800 } 1801 1802 /* Get key item */ 1803 err = AEGetKeyDesc(theAERecordPtr, 1804 TclaeGetOSTypeFromObj(theAEKeywordObjPtr), 1805 desiredType, 1806 keyAEDescPtr); 1807 if (err != noErr) { 1808 Tcl_ResetResult(interp); 1809 Tcl_AppendResult(interp, "Couldn't get keyword '", 1810 Tcl_GetString(theAEKeywordObjPtr), "' from \"", 1811 Tcl_GetString(theAERecordObjPtr), "\": ", 1812 Tcl_MacOSError(interp, err), 1813 (char *) NULL); 1814 return TCL_ERROR; 1815 } 1816 1817 return TCL_OK; 1818} 1819 1820/* 1821 * ------------------------------------------------------------------------- 1822 * 1823 * "TclaeGetNthDesc" -- 1824 * 1825 * Derive an AE descriptor from the supplied AEDescList object and 1826 * index. 1827 * 1828 * Results: 1829 * Tcl result code 1830 * 1831 * Side effects: 1832 * nthAEDescPtr points to (optionally coerced) AEDesc from AEDescList item. 1833 * nthAEDescPtr must already exist! 1834 * ------------------------------------------------------------------------- 1835 */ 1836int 1837TclaeGetNthDesc(Tcl_Interp *interp, /* for results */ 1838 Tcl_Obj *theAEDescListObjPtr, /* the AEDescList */ 1839 Tcl_Obj *theIndexObjPtr, /* nth item to retrieve */ 1840 Tcl_Obj *theDesiredTypeObjPtr, /* (optional) desired type */ 1841 Tcl_Obj *theKeywordVarObjPtr, /* to store keyword of item if 1842 * from AERecord */ 1843 AEDesc *nthAEDescPtr) /* pointer to new AEDesc from index */ 1844{ 1845 OSErr err; /* result from ToolBox calls */ 1846 int result; /* result from Tcl calls */ 1847 const AEDescList * theAEDescListPtr; /* pointer to AEDescList */ 1848 DescType desiredType = typeWildCard; /* optional type for new AEDesc */ 1849 AEKeyword theAEKeyword; /* Nth keyword, if AERecord */ 1850 int index; /* index of item to get */ 1851 1852 /* Obtain AEDescList pointer from object */ 1853 result = Tclae_GetConstAEDescFromObj(interp, theAEDescListObjPtr, &theAEDescListPtr, true); 1854 if (result != TCL_OK) { 1855 return TCL_ERROR; 1856 } 1857 1858 /* Read index to obtain AEDesc from */ 1859 result = Tcl_GetIntFromObj(interp, theIndexObjPtr, &index); 1860 if (result != TCL_OK) { 1861 return TCL_ERROR; 1862 } 1863 1864 if (theDesiredTypeObjPtr != NULL) { 1865 /* Optional desired type */ 1866 desiredType = TclaeGetOSTypeFromObj(theDesiredTypeObjPtr); 1867 } 1868 1869 /* Get nth item. 1870 * Tcl is 0-based, but AEDescLists are 1-based. 1871 */ 1872 err = AEGetNthDesc(theAEDescListPtr, index + 1, desiredType, 1873 &theAEKeyword, nthAEDescPtr); 1874 if (err != noErr) { 1875 Tcl_ResetResult(interp); 1876 Tcl_AppendResult(interp, "Couldn't get item #", 1877 Tcl_GetString(theIndexObjPtr), " from \"", 1878 Tcl_GetString(theAEDescListObjPtr), "\": ", 1879 Tcl_MacOSError(interp, err), 1880 (char *) NULL); 1881 return TCL_ERROR; 1882 } 1883 1884 if (theKeywordVarObjPtr != NULL) { 1885 /* Don't set theAEKeyword variable until now in the event that an error 1886 * occurs before we're done 1887 */ 1888 Tcl_ObjSetVar2(interp, theKeywordVarObjPtr, NULL, 1889 TclaeNewOSTypeObj(theAEKeyword), 0); 1890 } 1891 1892 return TCL_OK; 1893} 1894 1895/* 1896 * ------------------------------------------------------------------------- 1897 * 1898 * "TclaeGetOSTypeFromObj" -- 1899 * 1900 * Read string value of Tcl_Obj as though it's a FourCharCode 1901 * Convert to UTF and return 1902 * 1903 * We don't use Tcl_GetOSTypeFromObj because we need conversion from UTF 1904 * and AEGizmos requires more tolerant padding/truncation to 4 characters 1905 * 1906 * Results: 1907 * The extracted OSType 1908 * 1909 * Side effects: 1910 * None 1911 * ------------------------------------------------------------------------- 1912 */ 1913OSType 1914TclaeGetOSTypeFromObj(Tcl_Obj *objPtr) /* the input object */ 1915{ 1916 Tcl_DString osTypeDS; /* for UTF conversion */ 1917 OSType osType = kLSUnknownCreator; // ' '; 1918 char *osTypeStr; 1919 int len; 1920 1921 /* Convert object value from UTF */ 1922 osTypeStr = Tcl_UtfToExternalDString(tclAE_macRoman_encoding, Tcl_GetString(objPtr), -1, &osTypeDS); 1923 len = Tcl_DStringLength(&osTypeDS); 1924 1925 /* Check if OSType was single-quoted by caller */ 1926 if ((osTypeStr[0] == '\'') 1927 && (osTypeStr[len - 1] == '\'') 1928 && len == 6) { 1929 // strip close quote 1930 osTypeStr[len - 1] = '\0'; 1931 // move past open quote 1932 osTypeStr += 1; 1933 len -= 2; 1934 } else if ((osTypeStr[0] == '�') 1935 && (osTypeStr[len - 1] == '�') 1936 && len == 6) { 1937 // strip close quote 1938 osTypeStr[len - 1] = '\0'; 1939 // move past open quote 1940 osTypeStr += 1; 1941 len -= 2; 1942 } 1943 1944 if (len == 4) { 1945 osType = (OSType) osTypeStr[0] << 24 | 1946 (OSType) osTypeStr[1] << 16 | 1947 (OSType) osTypeStr[2] << 8 | 1948 (OSType) osTypeStr[3]; 1949 } 1950 1951 Tcl_DStringFree(&osTypeDS); 1952 1953 return osType; 1954} 1955 1956/* 1957 * ------------------------------------------------------------------------- 1958 * 1959 * "TclaeNewOSTypeObj" -- 1960 * 1961 * Convert a FourCharCode to UTF and place in a new Tcl_Obj 1962 * 1963 * We don't use Tcl_NewOSTypeObj because we need conversion to UTF 1964 * 1965 * Results: 1966 * Pointer to new Tcl_Obj 1967 * 1968 * Side effects: 1969 * None 1970 * ------------------------------------------------------------------------- 1971 */ 1972Tcl_Obj * 1973TclaeNewOSTypeObj(OSType theOSType) /* The desired OSType */ 1974{ 1975 char string[5]; 1976 Tcl_Obj * newOSTypeObj; /* to hold the result */ 1977 Tcl_DString theOSTypeDS; /* for conversion to UTF */ 1978 1979 /* Convert OSType to UTF */ 1980 string[0] = (char) (theOSType >> 24); 1981 string[1] = (char) (theOSType >> 16); 1982 string[2] = (char) (theOSType >> 8); 1983 string[3] = (char) (theOSType); 1984 string[4] = '\0'; 1985 Tcl_DStringInit(&theOSTypeDS); 1986 Tcl_ExternalToUtfDString(tclAE_macRoman_encoding, string, 1987 -1, &theOSTypeDS); 1988 /* Create new string object containing OSType */ 1989 newOSTypeObj = Tcl_NewStringObj(Tcl_DStringValue(&theOSTypeDS), -1); 1990 Tcl_DStringFree(&theOSTypeDS); 1991 1992 return newOSTypeObj; 1993} 1994 1995/* 1996 * ------------------------------------------------------------------------- 1997 * 1998 * "TclaePutKeyDesc" -- 1999 * 2000 * Get the AEDescList from the object and put the AEDesc into the 2001 * specified index position. 2002 * 2003 * Results: 2004 * Tcl result code 2005 * 2006 * Side effects: 2007 * keyAEDescPtr is inserted into the AERecord. 2008 * ------------------------------------------------------------------------- 2009 */ 2010int 2011TclaePutKeyDesc(Tcl_Interp *interp, /* for results */ 2012 Tcl_Obj *theAERecordObjPtr, /* the AERecord */ 2013 Tcl_Obj *theAEKeywordObjPtr, /* keyword item to insert */ 2014 AEDesc *keyAEDescPtr) /* pointer to AEDesc to place */ 2015{ 2016 OSErr err; /* result from ToolBox calls */ 2017 int result; /* result from Tcl calls */ 2018 AERecord * theAERecordPtr; /* pointer to AERecord */ 2019 2020 2021 /* Obtain AERecord pointer from reference */ 2022 result = Tclae_GetAEDescFromObj(interp, theAERecordObjPtr, &theAERecordPtr, true); 2023 if (result != TCL_OK) { 2024 return TCL_ERROR; 2025 } 2026 2027 /* Put new AEDesc into key entry of AERecord */ 2028 err = AEPutKeyDesc(theAERecordPtr, 2029 TclaeGetOSTypeFromObj(theAEKeywordObjPtr), 2030 keyAEDescPtr); 2031 if (err != noErr) { 2032 Tcl_ResetResult(interp); 2033 Tcl_AppendResult(interp, "Couldn't put AEDesc into key '", 2034 Tcl_GetString(theAEKeywordObjPtr), "' of \"", 2035 Tcl_GetString(theAERecordObjPtr), "\": ", 2036 Tcl_MacOSError(interp, err), 2037 (char *) NULL); 2038 return TCL_ERROR; 2039 } else { 2040 Tcl_InvalidateStringRep(theAERecordObjPtr); 2041 Tcl_SetObjResult(interp, theAERecordObjPtr); 2042 return TCL_OK; 2043 } 2044} 2045 2046/* 2047 * ------------------------------------------------------------------------- 2048 * 2049 * "TclaeDataFromAEDesc" -- 2050 * 2051 * Retrieve (possibly coerced) data from AEDesc as Tcl binary data. 2052 * 2053 * Results: 2054 * CmdReturn containing Tcl result code and data in Tcl_Obj. 2055 * 2056 * Side effects: 2057 * None. 2058 * ------------------------------------------------------------------------- 2059 */ 2060CmdReturn * 2061TclaeDataFromAEDesc(Tcl_Interp * interp, /* for error reporting */ 2062 const AEDesc * theAEDescPtr, /* pointer to original AEDesc */ 2063 Tcl_Obj * desiredTypePtr, /* desired descriptor type 2064 (NULL for no coercion) */ 2065 Tcl_Obj *typeCodeVarPtr) /* name of Tcl variable to 2066 store descriptor type 2067 (NULL for no variable) */ 2068{ 2069 CmdReturn * returnStructPtr; /* pointer to function result */ 2070 OSType typeCode = 0; 2071 OSType desiredType = typeWildCard; 2072 2073 if (desiredTypePtr != NULL) { 2074 desiredType = TclaeGetOSTypeFromObj(desiredTypePtr); 2075 } 2076 2077 switch (desiredType) { 2078 case kUnknownType: 2079 // unknown (but not missing) desiredType means to return 2080 // descriptor data as raw binary 2081 returnStructPtr = rawFromAEDesc(interp, theAEDescPtr); 2082 typeCode = theAEDescPtr->descriptorType; 2083 break; 2084 2085 case typeWildCard: 2086 returnStructPtr = dataFromAEDesc(interp, theAEDescPtr); 2087 typeCode = theAEDescPtr->descriptorType; 2088 break; 2089 2090 default: { 2091 AEDesc coercedAEDesc; /* temporary coerced AEDesc */ 2092 OSErr err; /* result from ToolBox calls */ 2093 2094 /* Coerce AEDesc to desiredType, if requested */ 2095 err = AECoerceDesc(theAEDescPtr, desiredType, &coercedAEDesc); 2096 if (err != noErr) { 2097 Tcl_ResetResult(interp); 2098 Tcl_AppendResult(interp, "Couldn't coerce descriptor to '", 2099 Tcl_GetString(desiredTypePtr), "': ", 2100 Tcl_MacOSError(interp, err), 2101 (char *) NULL); 2102 returnStructPtr = (CmdReturn *) ckalloc(sizeof(CmdReturn)); // das 25/10/00: Bugfix 2103 returnStructPtr->object = NULL; 2104 returnStructPtr->status = TCL_ERROR; 2105 } else { 2106 returnStructPtr = dataFromAEDesc(interp, &coercedAEDesc); 2107 typeCode = coercedAEDesc.descriptorType; 2108 AEDisposeDesc(&coercedAEDesc); 2109 } 2110 } 2111 break; 2112 } 2113 2114 /* Don't set the typeCode variable until now in the event that an error 2115 * occurs before we're done 2116 */ 2117 if ((typeCodeVarPtr != NULL) 2118 && (returnStructPtr->status == TCL_OK)) { 2119 Tcl_ObjSetVar2(interp, typeCodeVarPtr, NULL, TclaeNewOSTypeObj(typeCode), 0); 2120 } 2121 2122 return returnStructPtr; 2123} 2124 2125/* 2126 * ------------------------------------------------------------------------- 2127 * 2128 * "rawFromAEDesc" -- 2129 * 2130 * Retrieve raw binary data from AEDesc as Tcl ByteArray object. 2131 * 2132 * Results: 2133 * CmdReturn containing Tcl result code and data in Tcl_Obj. 2134 * 2135 * Side effects: 2136 * None. 2137 * ------------------------------------------------------------------------- 2138 */ 2139static CmdReturn * 2140rawFromAEDesc(Tcl_Interp *interp, /* for error reporting */ 2141 const AEDesc *theAEDescPtr) /* pointer to original AEDesc */ 2142{ 2143 CmdReturn * returnStructPtr; /* pointer to function result */ 2144 Ptr theData; 2145 Size theSize; 2146 2147 /* Initialize the return struct */ 2148 returnStructPtr = (CmdReturn *) ckalloc(sizeof(CmdReturn)); 2149 returnStructPtr->status = TCL_OK; 2150 returnStructPtr->object = NULL; 2151 2152 theData = TclaeAllocateAndGetDescData(theAEDescPtr, &theSize); 2153 2154 if (theData) { 2155 returnStructPtr->object = 2156 Tcl_NewByteArrayObj((unsigned char *) theData, 2157 theSize); 2158 2159 ckfree(theData); 2160 } else { 2161 returnStructPtr->status = TCL_ERROR; 2162 } 2163 2164 return returnStructPtr; 2165} 2166 2167/* 2168 * ------------------------------------------------------------------------- 2169 * 2170 * "dataFromAEDesc" -- 2171 * 2172 * Retrieve data from AEDesc as Tcl object. 2173 * 2174 * Results: 2175 * CmdReturn containing Tcl result code and data in Tcl_Obj. 2176 * 2177 * Side effects: 2178 * None. 2179 * ------------------------------------------------------------------------- 2180 */ 2181static CmdReturn * 2182dataFromAEDesc(Tcl_Interp *interp, /* for error reporting */ 2183 const AEDesc *theAEDescPtr) /* pointer to original AEDesc */ 2184{ 2185 OSErr err; /* result from ToolBox calls */ 2186 CmdReturn * returnStructPtr; /* pointer to function result */ 2187 2188 /* Initialize the return struct */ 2189 returnStructPtr = (CmdReturn *) ckalloc(sizeof(CmdReturn)); 2190 returnStructPtr->status = TCL_OK; 2191 returnStructPtr->object = NULL; 2192 2193 switch (theAEDescPtr->descriptorType) { 2194 case typeChar: { 2195 Tcl_DString dataDS; /* for conversion to UTF */ 2196 char * theData; 2197 Size theSize; 2198 2199 theData = TclaeAllocateAndGetDescData(theAEDescPtr, &theSize); 2200 2201 if (theData) { 2202 /* Convert data to UTF */ 2203 Tcl_ExternalToUtfDString(tclAE_macRoman_encoding, 2204 theData, theSize, &dataDS); 2205 2206 ckfree(theData); 2207 2208 returnStructPtr->object 2209 = Tcl_NewStringObj(Tcl_DStringValue(&dataDS), 2210 Tcl_DStringLength(&dataDS)); 2211 2212 Tcl_DStringFree(&dataDS); 2213 } else { 2214 returnStructPtr->status = TCL_ERROR; 2215 } 2216 } 2217 break; 2218 2219#if TARGET_API_MAC_CARBON 2220 case typeUnicodeText: { 2221 Tcl_UniChar * theUnicode; 2222 Size theSize; 2223 2224 theUnicode = TclaeAllocateAndGetDescData(theAEDescPtr, &theSize); 2225 2226 if (theUnicode) { 2227 returnStructPtr->object = Tcl_NewUnicodeObj(theUnicode, theSize / sizeof(Tcl_UniChar)); 2228 ckfree((char *) theUnicode); 2229 } else { 2230 returnStructPtr->status = TCL_ERROR; 2231 } 2232 } 2233 break; 2234 2235 case typeUTF8Text: { 2236 char * theUTF8; 2237 Size theSize; 2238 2239 theUTF8 = TclaeAllocateAndGetDescData(theAEDescPtr, &theSize); 2240 2241 if (theUTF8) { 2242 returnStructPtr->object = Tcl_NewStringObj(theUTF8, theSize); 2243 ckfree(theUTF8); 2244 } else { 2245 returnStructPtr->status = TCL_ERROR; 2246 } 2247 } 2248 break; 2249#endif // TARGET_API_MAC_CARBON 2250 2251 case typeBoolean: { 2252 AEDesc shorAEDesc; /* for coercion of boolean to integer */ 2253 short theData; 2254 2255 /* Coerce boolean descriptor to an integer (0 or 1) */ 2256 err = AECoerceDesc(theAEDescPtr, typeSInt16, &shorAEDesc); 2257 if (err != noErr) { 2258 Tcl_ResetResult(interp); 2259 Tcl_AppendResult(interp, "Couldn't coerce descriptor to 'shor': ", 2260 Tcl_MacOSError(interp, err), 2261 (char *) NULL); 2262 returnStructPtr->status = TCL_ERROR; 2263 return returnStructPtr; 2264 } 2265 /* Create new boolean object from value of AEDesc */ 2266 TclaeGetDescData(&shorAEDesc, &theData, sizeof(theData)); 2267 2268 returnStructPtr->object = Tcl_NewBooleanObj(theData); 2269 2270 AEDisposeDesc(&shorAEDesc); 2271 } 2272 break; 2273 2274 case typeSInt16: { 2275 short theData; 2276 2277 TclaeGetDescData(theAEDescPtr, &theData, sizeof(theData)); 2278 returnStructPtr->object = Tcl_NewIntObj(theData); 2279 } 2280 break; 2281 2282 case typeSInt32: { 2283#if __LP64__ 2284 short theData; 2285 2286 TclaeGetDescData(theAEDescPtr, &theData, sizeof(theData)); 2287 returnStructPtr->object = Tcl_NewIntObj(theData); 2288#else 2289 long theData; 2290 2291 TclaeGetDescData(theAEDescPtr, &theData, sizeof(theData)); 2292 returnStructPtr->object = Tcl_NewLongObj(theData); 2293#endif // __LP64__ 2294 } 2295 break; 2296 2297 case typeSInt64: { 2298#if __LP64__ 2299 long theData; 2300 2301 TclaeGetDescData(theAEDescPtr, &theData, sizeof(theData)); 2302 returnStructPtr->object = Tcl_NewLongObj(theData); 2303#else 2304 long long theData; 2305 2306 TclaeGetDescData(theAEDescPtr, &theData, sizeof(theData)); 2307 returnStructPtr->object = Tcl_NewWideIntObj(theData); 2308#endif // __LP64__ 2309 } 2310 break; 2311 2312 case typeIEEE32BitFloatingPoint: { 2313 double tempDbl; 2314 float theData; 2315 2316 TclaeGetDescData(theAEDescPtr, &theData, sizeof(theData)); 2317 tempDbl = theData; 2318 returnStructPtr->object = Tcl_NewDoubleObj(tempDbl); 2319 } 2320 break; 2321 2322 case typeIEEE64BitFloatingPoint: { 2323 double theData; 2324 2325 TclaeGetDescData(theAEDescPtr, &theData, sizeof(theData)); 2326 returnStructPtr->object = Tcl_NewDoubleObj(theData); 2327 } 2328 break; 2329 2330 case typeAEList: { 2331 long theCount, i; /* total number of items and index in AEDescList */ 2332 2333 returnStructPtr->object = Tcl_NewListObj(0, NULL); 2334 err = AECountItems((AEDescList *) theAEDescPtr, &theCount); 2335 if (err != noErr) { 2336 Tcl_ResetResult(interp); 2337 Tcl_AppendResult(interp, "Couldn't coerce descriptor to 'TEXT': ", 2338 Tcl_MacOSError(interp, err), 2339 (char *) NULL); 2340 returnStructPtr->status = TCL_ERROR; 2341 return returnStructPtr; 2342 } 2343 2344 /* Tcl is 0-based, but AEDescLists are 1-based. */ 2345 for (i = 1; i <= theCount; i++) { 2346 CmdReturn *elementStructPtr; /* result from item extraction */ 2347 AEDesc elementDesc; /* item AEDesc */ 2348 2349 /* Get the ith AEDesc from the AEDescList */ 2350 err = AEGetNthDesc((AEDescList *) theAEDescPtr, i, typeWildCard, 2351 NULL, &elementDesc); 2352 if (err != noErr) { 2353 Tcl_DecrRefCount(returnStructPtr->object); 2354 Tcl_ResetResult(interp); 2355 Tcl_AppendResult(interp, 2356 "Couldn't coerce list item to 'TEXT': ", 2357 Tcl_MacOSError(interp, err), 2358 (char *) NULL); 2359 returnStructPtr->status = TCL_ERROR; 2360 return returnStructPtr; 2361 } 2362 2363 /* Obtain uncoerced data from AEDesc */ 2364 elementStructPtr = TclaeDataFromAEDesc(interp, &elementDesc, 2365 NULL, NULL); 2366 2367 if (elementStructPtr->status != TCL_OK) { 2368 ckfree((char *)elementStructPtr); 2369 returnStructPtr->status = TCL_ERROR; 2370 return returnStructPtr; 2371 } 2372 2373 /* Append item to result list */ 2374 returnStructPtr->status 2375 = Tcl_ListObjAppendElement(interp, 2376 returnStructPtr->object, 2377 elementStructPtr->object); 2378 ckfree((char *)elementStructPtr); 2379 AEDisposeDesc(&elementDesc); 2380 } 2381 } 2382 break; 2383 2384 default: { 2385 ckfree((char *) returnStructPtr); 2386 returnStructPtr = rawFromAEDesc(interp, theAEDescPtr); 2387 } 2388 break; 2389 } 2390 2391 return returnStructPtr; 2392} 2393 2394#if TARGET_API_MAC_CARBON 2395 2396Size TclaeGetDescDataSize(const AEDesc * theAEDesc) 2397{ 2398 return AEGetDescDataSize(theAEDesc); 2399} 2400 2401OSErr TclaeGetDescData(const AEDesc * theAEDesc, 2402 void * dataPtr, 2403 Size maximumSize) 2404{ 2405 return AEGetDescData(theAEDesc, dataPtr, maximumSize); 2406} 2407 2408#else 2409 2410Size TclaeGetDescDataSize(const AEDesc * theAEDesc) 2411{ 2412 return GetHandleSize(theAEDesc->dataHandle); 2413} 2414 2415OSErr TclaeGetDescData(const AEDesc * theAEDesc, 2416 void * dataPtr, 2417 Size maximumSize) 2418{ 2419 Size size = GetHandleSize(theAEDesc->dataHandle); 2420 2421 HLock(theAEDesc->dataHandle); 2422 if (size > maximumSize) { 2423 size = maximumSize; 2424 } 2425 BlockMoveData(*theAEDesc->dataHandle, dataPtr, size); 2426 HUnlock(theAEDesc->dataHandle); 2427 2428 return noErr; 2429} 2430 2431#endif // TARGET_API_MAC_CARBON 2432 2433void * 2434TclaeAllocateAndGetDescData(const AEDesc * theAEDesc, 2435 Size * sizePtr) 2436{ 2437 Size theSize; 2438 void * dataPtr; 2439 2440 if (!sizePtr) { 2441 sizePtr = &theSize; 2442 } 2443 2444 *sizePtr = TclaeGetDescDataSize(theAEDesc); 2445 dataPtr = ckalloc(*sizePtr); 2446 if (TclaeGetDescData(theAEDesc, dataPtr, *sizePtr) != noErr) { 2447 ckfree(dataPtr); 2448 return NULL; 2449 } else { 2450 return dataPtr; 2451 } 2452} 2453