1/* 2 * tclMacOSA.c -- 3 * 4 * This contains the initialization routines, and the implementation of 5 * the OSA and Component commands. These commands allow you to connect 6 * with the AppleScript or any other OSA component to compile and execute 7 * scripts. 8 * 9 * Copyright (c) 1996 Lucent Technologies and Jim Ingham 10 * Copyright (c) 1997 Sun Microsystems, Inc. 11 * 12 * See the file "License Terms" for information on usage and redistribution 13 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 14 * 15 * RCS: @(#) $Id: tclMacOSA_OSX.c,v 1.2 2007/08/23 10:58:27 das Exp $ 16 */ 17 18#ifdef TclAS_OSX 19#ifdef TclAS_USE_FRAMEWORK_INCLUDES 20#include <Tcl/tcl.h> 21#else 22#include <tcl.h> 23#endif 24#include <osxMacTcl.h> 25#else 26#include "tcl.h" 27#include "tclInt.h" 28#include "tclMacInt.h" 29 30#include <Aliases.h> 31#include <string.h> 32#include <AppleEvents.h> 33#include <AppleScript.h> 34#include <OSA.h> 35#include <OSAGeneric.h> 36#include <Script.h> 37 38#include <components.h> 39 40#include <resources.h> 41#include <FSpCompat.h> 42/* 43 * The following two Includes are from the More Files package. 44 */ 45#include <MoreFiles.h> 46#include <FullPath.h> 47 48#endif 49 50 51/* 52 * Data structures used by the OSA code. 53 */ 54typedef struct tclOSAScript { 55 OSAID scriptID; 56 OSType languageID; 57 long modeFlags; 58} tclOSAScript; 59 60typedef struct tclOSAContext { 61 OSAID contextID; 62} tclOSAContext; 63 64typedef struct tclOSAComponent { 65 char *theName; 66 ComponentInstance theComponent; /* The OSA Component represented */ 67 long componentFlags; 68 OSType languageID; 69 char *languageName; 70 Tcl_HashTable contextTable; /* Hash Table linking the context names & ID's */ 71 Tcl_HashTable scriptTable; 72 Tcl_Interp *theInterp; 73 OSAActiveUPP defActiveProc; 74 long defRefCon; 75} tclOSAComponent; 76 77/* 78 * Prototypes for static procedures. 79 */ 80 81static pascal OSErr TclOSAActiveProc _ANSI_ARGS_((long refCon)); 82static int TclOSACompileCmd _ANSI_ARGS_((Tcl_Interp *interp, 83 tclOSAComponent *OSAComponent, int argc, 84 CONST char **argv)); 85static int tclOSADecompileCmd _ANSI_ARGS_((Tcl_Interp * Interp, 86 tclOSAComponent *OSAComponent, int argc, 87 CONST char **argv)); 88static int tclOSADeleteCmd _ANSI_ARGS_((Tcl_Interp *interp, 89 tclOSAComponent *OSAComponent, int argc, 90 CONST char **argv)); 91static int tclOSAExecuteCmd _ANSI_ARGS_((Tcl_Interp *interp, 92 tclOSAComponent *OSAComponent, int argc, 93 CONST char **argv)); 94static int tclOSAInfoCmd _ANSI_ARGS_((Tcl_Interp *interp, 95 tclOSAComponent *OSAComponent, int argc, 96 CONST char **argv)); 97static int tclOSALoadCmd _ANSI_ARGS_((Tcl_Interp *interp, 98 tclOSAComponent *OSAComponent, int argc, 99 CONST char **argv)); 100static int tclOSARunCmd _ANSI_ARGS_((Tcl_Interp *interp, 101 tclOSAComponent *OSAComponent, int argc, 102 CONST char **argv)); 103static int tclOSAStoreCmd _ANSI_ARGS_((Tcl_Interp *interp, 104 tclOSAComponent *OSAComponent, int argc, 105 CONST char **argv)); 106static void GetRawDataFromDescriptor _ANSI_ARGS_((AEDesc *theDesc, 107 Ptr destPtr, Size destMaxSize, Size *actSize)); 108static OSErr GetCStringFromDescriptor _ANSI_ARGS_(( 109 AEDesc *sourceDesc, char *resultStr, 110 Size resultMaxSize,Size *resultSize)); 111static int Tcl_OSAComponentCmd _ANSI_ARGS_((ClientData clientData, 112 Tcl_Interp *interp, int argc, CONST char **argv)); 113static void getSortedHashKeys _ANSI_ARGS_((Tcl_HashTable *theTable, 114 CONST char *pattern, Tcl_DString *theResult)); 115static int ASCIICompareProc _ANSI_ARGS_((const void *first, 116 const void *second)); 117/*static int Tcl_OSACmd _ANSI_ARGS_((ClientData clientData, 118 Tcl_Interp *interp, int argc, CONST char **argv)); */ 119static void tclOSAClose _ANSI_ARGS_((ClientData clientData)); 120/*static void tclOSACloseAll _ANSI_ARGS_((ClientData clientData));*/ 121static tclOSAComponent *tclOSAMakeNewComponent _ANSI_ARGS_((Tcl_Interp *interp, 122 char *cmdName, char *languageName, 123 OSType scriptSubtype, long componentFlags)); 124static int prepareScriptData _ANSI_ARGS_((int argc, CONST char **argv, 125 Tcl_DString *scrptData ,AEDesc *scrptDesc)); 126static void tclOSAResultFromID _ANSI_ARGS_((Tcl_Interp *interp, 127 ComponentInstance theComponent, OSAID resultID)); 128static void tclOSAASError _ANSI_ARGS_((Tcl_Interp * interp, 129 ComponentInstance theComponent, char *scriptSource)); 130static int tclOSAGetContextID _ANSI_ARGS_((tclOSAComponent *theComponent, 131 CONST char *contextName, OSAID *theContext)); 132static void tclOSAAddContext _ANSI_ARGS_((tclOSAComponent *theComponent, 133 char *contextName, const OSAID theContext)); 134static int tclOSAMakeContext _ANSI_ARGS_((tclOSAComponent *theComponent, 135 CONST char *contextName, OSAID *theContext)); 136static int tclOSADeleteContext _ANSI_ARGS_((tclOSAComponent *theComponent, 137 CONST char *contextName)); 138static int tclOSALoad _ANSI_ARGS_((Tcl_Interp *interp, 139 tclOSAComponent *theComponent, CONST char *resourceName, 140 int resourceNumber, CONST char *fileName,OSAID *resultID)); 141static int tclOSAStore _ANSI_ARGS_((Tcl_Interp *interp, 142 tclOSAComponent *theComponent, CONST char *resourceName, 143 int resourceNumber, CONST char *scriptName, CONST char *fileName)); 144static int tclOSAAddScript _ANSI_ARGS_((tclOSAComponent *theComponent, 145 char *scriptName, long modeFlags, OSAID scriptID)); 146static int tclOSAGetScriptID _ANSI_ARGS_((tclOSAComponent *theComponent, 147 CONST char *scriptName, OSAID *scriptID)); 148static tclOSAScript * tclOSAGetScript _ANSI_ARGS_((tclOSAComponent *theComponent, 149 CONST char *scriptName)); 150static int tclOSADeleteScript _ANSI_ARGS_((tclOSAComponent *theComponent, 151 CONST char *scriptName,char *errMsg)); 152 153/* 154 * "export" is a MetroWerks specific pragma. It flags the linker that 155 * any symbols that are defined when this pragma is on will be exported 156 * to shared libraries that link with this library. 157 */ 158 159 160#pragma export on 161int Tclapplescript_Init( Tcl_Interp *interp ); 162#pragma export reset 163 164/* 165 *---------------------------------------------------------------------- 166 * 167 * Tclapplescript_Init -- 168 * 169 * Initializes the the OSA command which opens connections to 170 * OSA components, creates the AppleScript command, which opens an 171 * instance of the AppleScript component,and constructs the table of 172 * available languages. 173 * 174 * Results: 175 * A standard Tcl result. 176 * 177 * Side Effects: 178 * Opens one connection to the AppleScript component, if 179 * available. Also builds up a table of available OSA languages, 180 * and creates the OSA command. 181 * 182 *---------------------------------------------------------------------- 183 */ 184 185int 186Tclapplescript_Init( 187 Tcl_Interp *interp) /* Tcl interpreter. */ 188{ 189 OSErr myErr = noErr; 190 Boolean gotAppleScript = false; 191 Boolean GotOneOSALanguage = false; 192 ComponentDescription compDescr = { 193 kOSAComponentType, 194 (OSType) 0, 195 (OSType) 0, 196 (long) 0, 197 (long) 0 198 }, *foundComp; 199 Component curComponent = (Component) 0; 200 ComponentInstance curOpenComponent; 201 Tcl_HashTable *ComponentTable; 202 Tcl_HashTable *LanguagesTable; 203 Tcl_HashEntry *hashEntry; 204 int newPtr; 205 AEDesc componentName = { typeNull, NULL }; 206 char nameStr[32]; 207 Size nameLen; 208 long appleScriptFlags = 0; 209 210 /* 211 * Perform the required stubs magic... 212 */ 213 214 if (!Tcl_InitStubs(interp, "8.2", 0)) { 215 return TCL_ERROR; 216 } 217 218 /* 219 * Here We Will Get The Available Osa Languages, Since They Can Only Be 220 * Registered At Startup... If You Dynamically Load Components, This 221 * Will Fail, But This Is Not A Common Thing To Do. 222 */ 223 224 LanguagesTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); 225 226 if (LanguagesTable == NULL) { 227 panic("Memory Error Allocating Languages Hash Table"); 228 } 229 230 Tcl_SetAssocData(interp, "OSAScript_LangTable", NULL, LanguagesTable); 231 Tcl_InitHashTable(LanguagesTable, TCL_STRING_KEYS); 232 233 234 while ((curComponent = FindNextComponent(curComponent, &compDescr)) != 0) { 235 foundComp = (ComponentDescription *) 236 ckalloc(sizeof(ComponentDescription)); 237 myErr = GetComponentInfo(curComponent, foundComp, NULL, NULL, NULL); 238 if (foundComp->componentSubType == 239 kOSAGenericScriptingComponentSubtype) { 240 /* Skip the generic component */ 241 ckfree((char *) foundComp); 242 } else { 243 GotOneOSALanguage = true; 244 245 /* 246 * This is gross: looks like I have to open the component just 247 * to get its name!!! GetComponentInfo is supposed to return 248 * the name, but AppleScript always returns an empty string. 249 */ 250 251 curOpenComponent = OpenComponent(curComponent); 252 if (curOpenComponent == NULL) { 253 Tcl_AppendResult(interp,"Error opening component", 254 (char *) NULL); 255 return TCL_ERROR; 256 } 257 258 myErr = OSAScriptingComponentName(curOpenComponent,&componentName); 259 if (myErr == noErr) { 260 myErr = GetCStringFromDescriptor(&componentName, 261 nameStr, 31, &nameLen); 262 AEDisposeDesc(&componentName); 263 } 264 CloseComponent(curOpenComponent); 265 266 if (myErr == noErr) { 267 hashEntry = Tcl_CreateHashEntry(LanguagesTable, 268 nameStr, &newPtr); 269 Tcl_SetHashValue(hashEntry, (ClientData) foundComp); 270 } else { 271 Tcl_AppendResult(interp,"Error getting componentName.", 272 (char *) NULL); 273 return TCL_ERROR; 274 } 275 276 /* 277 * Make sure AppleScript is loaded, otherwise we will 278 * not bother to make the AppleScript command. 279 */ 280 if (foundComp->componentSubType == kAppleScriptSubtype) { 281 appleScriptFlags = foundComp->componentFlags; 282 gotAppleScript = true; 283 } 284 } 285 } 286 287 /* 288 * Create the OSA command. 289 */ 290 291 if (!GotOneOSALanguage) { 292 Tcl_AppendResult(interp,"Could not find any OSA languages", 293 (char *) NULL); 294 return TCL_ERROR; 295 } 296 297 /* 298 * Create the Component Assoc Data & put it in the interpreter. 299 */ 300 301 ComponentTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); 302 303 if (ComponentTable == NULL) { 304 panic("Memory Error Allocating Hash Table"); 305 } 306 307 Tcl_SetAssocData(interp, "OSAScript_CompTable", NULL, ComponentTable); 308 309 Tcl_InitHashTable(ComponentTable, TCL_STRING_KEYS); 310 311 /* 312 * The OSA command is not currently supported. 313 Tcl_CreateCommand(interp, "OSA", Tcl_OSACmd, (ClientData) NULL, 314 (Tcl_CmdDeleteProc *) NULL); 315 */ 316 317 /* 318 * Open up one AppleScript component, with a default context 319 * and tie it to the AppleScript command. 320 * If the user just wants single-threaded AppleScript execution 321 * this should be enough. 322 * 323 */ 324 325 if (gotAppleScript) { 326 if (tclOSAMakeNewComponent(interp, "AppleScript", 327 "AppleScript English", kAppleScriptSubtype, 328 appleScriptFlags) == NULL ) { 329 return TCL_ERROR; 330 } 331 } 332 333/* return Tcl_PkgProvide(interp, "OSAConnect", "1.0"); */ 334 return Tcl_PkgProvide(interp, "Tclapplescript", "1.0"); 335} 336 337#if 0 338/* 339 *---------------------------------------------------------------------- 340 * 341 * Tcl_OSACmd -- 342 * 343 * This is the command that provides the interface to the OSA 344 * component manager. The subcommands are: close: close a component, 345 * info: get info on components open, and open: get a new connection 346 * with the Scripting Component 347 * 348 * Results: 349 * A standard Tcl result. 350 * 351 * Side effects: 352 * Depends on the subcommand, see the user documentation 353 * for more details. 354 * 355 *---------------------------------------------------------------------- 356 */ 357 358int 359Tcl_OSACmd( 360 ClientData clientData, 361 Tcl_Interp *interp, 362 int argc, 363 CONST char **argv) 364{ 365 static unsigned short componentCmdIndex = 0; 366 char autoName[32]; 367 char c; 368 int length; 369 Tcl_HashTable *ComponentTable = NULL; 370 371 372 if (argc == 1) { 373 Tcl_AppendResult(interp, "Wrong # of arguments, should be \"", 374 argv[0], " option\"", (char *) NULL); 375 return TCL_ERROR; 376 } 377 378 c = *argv[1]; 379 length = strlen(argv[1]); 380 381 /* 382 * Query out the Component Table, since most of these commands use it... 383 */ 384 385 ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp, 386 "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL); 387 388 if (ComponentTable == NULL) { 389 Tcl_AppendResult(interp, "Error, could not get the Component Table", 390 " from the Associated data.", (char *) NULL); 391 return TCL_ERROR; 392 } 393 394 if (c == 'c' && strncmp(argv[1],"close",length) == 0) { 395 Tcl_HashEntry *hashEntry; 396 if (argc != 3) { 397 Tcl_AppendResult(interp, "Wrong # of arguments, should be \"", 398 argv[0], " ",argv[1], " componentName\"", 399 (char *) NULL); 400 return TCL_ERROR; 401 } 402 403 if ((hashEntry = Tcl_FindHashEntry(ComponentTable,argv[2])) == NULL) { 404 Tcl_AppendResult(interp, "Component \"", argv[2], "\" not found", 405 (char *) NULL); 406 return TCL_ERROR; 407 } else { 408 Tcl_DeleteCommand(interp,argv[2]); 409 return TCL_OK; 410 } 411 } else if (c == 'o' && strncmp(argv[1],"open",length) == 0) { 412 /* 413 * Default language is AppleScript. 414 */ 415 OSType scriptSubtype = kAppleScriptSubtype; 416 char *languageName = "AppleScript English"; 417 char *errMsg = NULL; 418 ComponentDescription *theCD; 419 420 argv += 2; 421 argc -= 2; 422 423 while (argc > 0 ) { 424 if (*argv[0] == '-') { 425 c = *(argv[0] + 1); 426 if (c == 'l' && strcmp(argv[0] + 1, "language") == 0) { 427 if (argc == 1) { 428 Tcl_AppendResult(interp, 429 "Error - no language provided for the -language switch", 430 (char *) NULL); 431 return TCL_ERROR; 432 } else { 433 Tcl_HashEntry *hashEntry; 434 Tcl_HashSearch search; 435 Boolean gotIt = false; 436 Tcl_HashTable *LanguagesTable; 437 438 /* 439 * Look up the language in the languages table 440 * Do a simple strstr match, so AppleScript 441 * will match "AppleScript English"... 442 */ 443 444 LanguagesTable = Tcl_GetAssocData(interp, 445 "OSAScript_LangTable", 446 (Tcl_InterpDeleteProc **) NULL); 447 448 for (hashEntry = 449 Tcl_FirstHashEntry(LanguagesTable, &search); 450 hashEntry != NULL; 451 hashEntry = Tcl_NextHashEntry(&search)) { 452 languageName = Tcl_GetHashKey(LanguagesTable, 453 hashEntry); 454 if (strstr(languageName,argv[1]) != NULL) { 455 theCD = (ComponentDescription *) 456 Tcl_GetHashValue(hashEntry); 457 gotIt = true; 458 break; 459 } 460 } 461 if (!gotIt) { 462 Tcl_AppendResult(interp, 463 "Error, could not find the language \"", 464 argv[1], 465 "\" in the list of known languages.", 466 (char *) NULL); 467 return TCL_ERROR; 468 } 469 } 470 } 471 argc -= 2; 472 argv += 2; 473 } else { 474 Tcl_AppendResult(interp, "Expected a flag, but got ", 475 argv[0], (char *) NULL); 476 return TCL_ERROR; 477 } 478 } 479 480 sprintf(autoName, "OSAComponent%-d", componentCmdIndex++); 481 if (tclOSAMakeNewComponent(interp, autoName, languageName, 482 theCD->componentSubType, theCD->componentFlags) == NULL ) { 483 return TCL_ERROR; 484 } else { 485 Tcl_SetResult(interp,autoName,TCL_VOLATILE); 486 return TCL_OK; 487 } 488 489 } else if (c == 'i' && strncmp(argv[1],"info",length) == 0) { 490 if (argc == 2) { 491 Tcl_AppendResult(interp, "Wrong # of arguments, should be \"", 492 argv[0], " ", argv[1], " what\"", 493 (char *) NULL); 494 return TCL_ERROR; 495 } 496 497 c = *argv[2]; 498 length = strlen(argv[2]); 499 500 if (c == 'c' && strncmp(argv[2], "components", length) == 0) { 501 Tcl_DString theResult; 502 503 Tcl_DStringInit(&theResult); 504 505 if (argc == 3) { 506 getSortedHashKeys(ComponentTable,(char *) NULL, &theResult); 507 } else if (argc == 4) { 508 getSortedHashKeys(ComponentTable, argv[3], &theResult); 509 } else { 510 Tcl_AppendResult(interp, "Error: wrong # of arguments", 511 ", should be \"", argv[0], " ", argv[1], " ", 512 argv[2], " ?pattern?\".", (char *) NULL); 513 return TCL_ERROR; 514 } 515 Tcl_DStringResult(interp, &theResult); 516 return TCL_OK; 517 } else if (c == 'l' && strncmp(argv[2],"languages",length) == 0) { 518 Tcl_DString theResult; 519 Tcl_HashTable *LanguagesTable; 520 521 Tcl_DStringInit(&theResult); 522 LanguagesTable = Tcl_GetAssocData(interp, 523 "OSAScript_LangTable", (Tcl_InterpDeleteProc **) NULL); 524 525 if (argc == 3) { 526 getSortedHashKeys(LanguagesTable, (char *) NULL, &theResult); 527 } else if (argc == 4) { 528 getSortedHashKeys(LanguagesTable, argv[3], &theResult); 529 } else { 530 Tcl_AppendResult(interp, "Error: wrong # of arguments", 531 ", should be \"", argv[0], " ", argv[1], " ", 532 argv[2], " ?pattern?\".", (char *) NULL); 533 return TCL_ERROR; 534 } 535 Tcl_DStringResult(interp,&theResult); 536 return TCL_OK; 537 } else { 538 Tcl_AppendResult(interp, "Unknown option: ", argv[2], 539 " for OSA info, should be one of", 540 " \"components\" or \"languages\"", 541 (char *) NULL); 542 return TCL_ERROR; 543 } 544 } else { 545 Tcl_AppendResult(interp, "Unknown option: ", argv[1], 546 ", should be one of \"open\", \"close\" or \"info\".", 547 (char *) NULL); 548 return TCL_ERROR; 549 } 550 return TCL_OK; 551} 552#endif 553/* 554 *---------------------------------------------------------------------- 555 * 556 * Tcl_OSAComponentCmd -- 557 * 558 * This is the command that provides the interface with an OSA 559 * component. The sub commands are: 560 * - compile ? -context context? scriptData 561 * compiles the script data, returns the ScriptID 562 * - decompile ? -context context? scriptData 563 * decompiles the script data, source code 564 * - execute ?-context context? scriptData 565 * compiles and runs script data 566 * - info what: get component info 567 * - load ?-flags values? fileName 568 * loads & compiles script data from fileName 569 * - run scriptId ?options? 570 * executes the compiled script 571 * 572 * Results: 573 * A standard Tcl result 574 * 575 * Side Effects: 576 * Depends on the subcommand, see the user documentation 577 * for more details. 578 * 579 *---------------------------------------------------------------------- 580 */ 581 582int 583Tcl_OSAComponentCmd( 584 ClientData clientData, 585 Tcl_Interp *interp, 586 int argc, 587 CONST char **argv) 588{ 589 int length; 590 char c; 591 592 tclOSAComponent *OSAComponent = (tclOSAComponent *) clientData; 593 594 if (argc == 1) { 595 Tcl_AppendResult(interp, "wrong # args: should be \"", 596 argv[0], " option ?arg ...?\"", 597 (char *) NULL); 598 return TCL_ERROR; 599 } 600 601 c = *argv[1]; 602 length = strlen(argv[1]); 603 if (c == 'c' && strncmp(argv[1], "compile", length) == 0) { 604 return TclOSACompileCmd(interp, OSAComponent, argc, argv); 605 } else if (c == 'l' && strncmp(argv[1], "load", length) == 0) { 606 return tclOSALoadCmd(interp, OSAComponent, argc, argv); 607 } else if (c == 'e' && strncmp(argv[1], "execute", length) == 0) { 608 return tclOSAExecuteCmd(interp, OSAComponent, argc, argv); 609 } else if (c == 'i' && strncmp(argv[1], "info", length) == 0) { 610 return tclOSAInfoCmd(interp, OSAComponent, argc, argv); 611 } else if (c == 'd' && strncmp(argv[1], "decompile", length) == 0) { 612 return tclOSADecompileCmd(interp, OSAComponent, argc, argv); 613 } else if (c == 'd' && strncmp(argv[1], "delete", length) == 0) { 614 return tclOSADeleteCmd(interp, OSAComponent, argc, argv); 615 } else if (c == 'r' && strncmp(argv[1], "run", length) == 0) { 616 return tclOSARunCmd(interp, OSAComponent, argc, argv); 617 } else if (c == 's' && strncmp(argv[1], "store", length) == 0) { 618 return tclOSAStoreCmd(interp, OSAComponent, argc, argv); 619 } else { 620 Tcl_AppendResult(interp,"bad option \"", argv[1], 621 "\": should be compile, decompile, delete, ", 622 "execute, info, load, run or store", 623 (char *) NULL); 624 return TCL_ERROR; 625 } 626 627 return TCL_OK; 628} 629 630/* 631 *---------------------------------------------------------------------- 632 * 633 * TclOSACompileCmd -- 634 * 635 * This is the compile subcommand for the component command. 636 * 637 * Results: 638 * A standard Tcl result 639 * 640 * Side Effects: 641 * Compiles the script data either into a script or a script 642 * context. Adds the script to the component's script or context 643 * table. Sets interp's result to the name of the new script or 644 * context. 645 * 646 *---------------------------------------------------------------------- 647 */ 648 649static int 650TclOSACompileCmd( 651 Tcl_Interp *interp, 652 tclOSAComponent *OSAComponent, 653 int argc, 654 CONST char **argv) 655{ 656 int tclError = TCL_OK; 657 int augment = 1; 658 int makeContext = 0; 659 char c; 660 char autoName[16]; 661 char buffer[32]; 662 char *resultName; 663 Boolean makeNewContext = false; 664 Tcl_DString scrptData; 665 AEDesc scrptDesc = { typeNull, NULL }; 666 long modeFlags = kOSAModeCanInteract; 667 OSAID resultID = kOSANullScript; 668 OSAID parentID = kOSANullScript; 669 OSAError osaErr = noErr; 670 671 if (!(OSAComponent->componentFlags && kOSASupportsCompiling)) { 672 Tcl_AppendResult(interp, 673 "OSA component does not support compiling", 674 (char *) NULL); 675 return TCL_ERROR; 676 } 677 678 /* 679 * This signals that we should make up a name, which is the 680 * default behavior: 681 */ 682 683 autoName[0] = '\0'; 684 resultName = NULL; 685 686 if (argc == 2) { 687 numArgs: 688 Tcl_AppendResult(interp, 689 "wrong # args: should be \"", argv[0], " ", argv[1], 690 " ?options? code\"",(char *) NULL); 691 return TCL_ERROR; 692 } 693 694 argv += 2; 695 argc -= 2; 696 697 /* 698 * Do the argument parsing. 699 */ 700 701 while (argc > 0) { 702 703 if (*argv[0] == '-') { 704 c = *(argv[0] + 1); 705 706 /* 707 * "--" is the only switch that has no value, stops processing 708 */ 709 710 if (c == '-' && *(argv[0] + 2) == '\0') { 711 argv += 1; 712 argc--; 713 break; 714 } 715 716 /* 717 * So we can check here a switch with no value. 718 */ 719 720 if (argc == 1) { 721 Tcl_AppendResult(interp, 722 "no value given for switch: ", 723 argv[0], (char *) NULL); 724 return TCL_ERROR; 725 } 726 727 if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) { 728 if (Tcl_GetBoolean(interp, argv[1], &makeContext) != TCL_OK) { 729 return TCL_ERROR; 730 } 731 } else if (c == 'a' && strcmp(argv[0] + 1, "augment") == 0) { 732 /* 733 * Augment the current context which implies making a context. 734 */ 735 736 if (Tcl_GetBoolean(interp, argv[1], &augment) != TCL_OK) { 737 return TCL_ERROR; 738 } 739 makeContext = 1; 740 } else if (c == 'n' && strcmp(argv[0] + 1, "name") == 0) { 741 strncpy(autoName, argv[1], 15); 742 autoName[15] = '\0'; 743 resultName = autoName; 744 } else if (c == 'p' && strcmp(argv[0] + 1,"parent") == 0) { 745 /* 746 * Since this implies we are compiling into a context, 747 * set makeContext here 748 */ 749 if (tclOSAGetContextID(OSAComponent, 750 argv[1], &parentID) != TCL_OK) { 751 Tcl_AppendResult(interp, "context not found \"", 752 argv[1], "\"", (char *) NULL); 753 return TCL_ERROR; 754 } 755 makeContext = 1; 756 } else { 757 Tcl_AppendResult(interp, "bad option \"", argv[0], 758 "\": should be -augment, -context, -name or -parent", 759 (char *) NULL); 760 return TCL_ERROR; 761 } 762 argv += 2; 763 argc -= 2; 764 765 } else { 766 break; 767 } 768 } 769 770 /* 771 * Make sure we have some data left... 772 */ 773 if (argc == 0) { 774 goto numArgs; 775 } 776 777 /* 778 * Now if we are making a context, see if it is a new one... 779 * There are three options here: 780 * 1) There was no name provided, so we autoName it 781 * 2) There was a name, then check and see if it already exists 782 * a) If yes, then makeNewContext is false 783 * b) Otherwise we are making a new context 784 */ 785 786 if (makeContext) { 787 modeFlags |= kOSAModeCompileIntoContext; 788 if (resultName == NULL) { 789 /* 790 * Auto name the new context. 791 */ 792 resultName = autoName; 793 resultID = kOSANullScript; 794 makeNewContext = true; 795 } else if (tclOSAGetContextID(OSAComponent, 796 resultName, &resultID) == TCL_OK) { 797 } else { 798 makeNewContext = true; 799 } 800 801 /* 802 * Deal with the augment now... 803 */ 804 if (augment && !makeNewContext) { 805 modeFlags |= kOSAModeAugmentContext; 806 } 807 } else if (resultName == NULL) { 808 resultName = autoName; /* Auto name the script */ 809 } 810 811 /* 812 * Ok, now we have the options, so we can compile the script data. 813 */ 814 815 if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) { 816 Tcl_DStringResult(interp, &scrptData); 817 AEDisposeDesc(&scrptDesc); 818 return TCL_ERROR; 819 } 820 821 /* 822 * If we want to use a parent context, we have to make the context 823 * by hand. Note, parentID is only specified when you make a new context. 824 */ 825 826 if (parentID != kOSANullScript && makeNewContext) { 827 AEDesc contextDesc = { typeNull, NULL }; 828 829 osaErr = OSAMakeContext(OSAComponent->theComponent, 830 &contextDesc, parentID, &resultID); 831 modeFlags |= kOSAModeAugmentContext; 832 } 833 834 osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc, 835 modeFlags, &resultID); 836 if (osaErr == noErr) { 837 838 if (makeContext) { 839 /* 840 * For the compiled context to be active, you need to run 841 * the code that is in the context. 842 */ 843 OSAID activateID; 844 845 osaErr = OSAExecute(OSAComponent->theComponent, resultID, 846 resultID, kOSAModeCanInteract, &activateID); 847 OSADispose(OSAComponent->theComponent, activateID); 848 849 if (osaErr == noErr) { 850 if (makeNewContext) { 851 /* 852 * If we have compiled into a context, 853 * this is added to the context table 854 */ 855 856 tclOSAAddContext(OSAComponent, resultName, resultID); 857 } 858 859 Tcl_SetResult(interp, resultName, TCL_VOLATILE); 860 tclError = TCL_OK; 861 } 862 } else { 863 /* 864 * For a script, we return the script name. 865 */ 866 tclOSAAddScript(OSAComponent, resultName, modeFlags, resultID); 867 Tcl_SetResult(interp, resultName, TCL_VOLATILE); 868 tclError = TCL_OK; 869 } 870 } 871 872 /* 873 * This catches the error either from the original compile, 874 * or from the execute in case makeContext == true 875 */ 876 877 if (osaErr == errOSAScriptError) { 878 OSADispose(OSAComponent->theComponent, resultID); 879 tclOSAASError(interp, OSAComponent->theComponent, 880 Tcl_DStringValue(&scrptData)); 881 tclError = TCL_ERROR; 882 } else if (osaErr != noErr) { 883 sprintf(buffer, "Error #%-6ld compiling script", (long)osaErr); 884 Tcl_AppendResult(interp, buffer, (char *) NULL); 885 tclError = TCL_ERROR; 886 } 887 888 Tcl_DStringFree(&scrptData); 889 AEDisposeDesc(&scrptDesc); 890 891 return tclError; 892} 893 894/* 895 *---------------------------------------------------------------------- 896 * 897 * tclOSADecompileCmd -- 898 * 899 * This implements the Decompile subcommand of the component command 900 * 901 * Results: 902 * A standard Tcl result. 903 * 904 * Side Effects: 905 * Decompiles the script, and sets interp's result to the 906 * decompiled script data. 907 * 908 *---------------------------------------------------------------------- 909 */ 910 911static int 912tclOSADecompileCmd( 913 Tcl_Interp * interp, 914 tclOSAComponent *OSAComponent, 915 int argc, 916 CONST char **argv) 917{ 918 AEDesc resultingSourceData = { typeChar, NULL }; 919 OSAID scriptID; 920 Boolean isContext; 921 long result; 922 OSErr sysErr = noErr; 923 924 if (argc == 2) { 925 Tcl_AppendResult(interp, "Wrong # of arguments, should be \"", 926 argv[0], " ",argv[1], " scriptName \"", (char *) NULL ); 927 return TCL_ERROR; 928 } 929 930 if (!(OSAComponent->componentFlags && kOSASupportsGetSource)) { 931 Tcl_AppendResult(interp, 932 "Error, this component does not support get source", 933 (char *) NULL); 934 return TCL_ERROR; 935 } 936 937 if (tclOSAGetScriptID(OSAComponent, argv[2], &scriptID) == TCL_OK) { 938 isContext = false; 939 } else if (tclOSAGetContextID(OSAComponent, argv[2], &scriptID) 940 == TCL_OK ) { 941 isContext = true; 942 } else { 943 Tcl_AppendResult(interp, "Could not find script \"", 944 argv[2], "\"", (char *) NULL); 945 return TCL_ERROR; 946 } 947 948 OSAGetScriptInfo(OSAComponent->theComponent, scriptID, 949 kOSACanGetSource, &result); 950 951 sysErr = OSAGetSource(OSAComponent->theComponent, 952 scriptID, typeChar, &resultingSourceData); 953 954 if (sysErr == noErr) { 955 Tcl_DString theResult; 956 Tcl_DStringInit(&theResult); 957 958 Tcl_DStringAppend(&theResult, *resultingSourceData.dataHandle, 959 GetHandleSize( resultingSourceData.dataHandle)); 960 Tcl_DStringResult(interp, &theResult); 961 AEDisposeDesc(&resultingSourceData); 962 return TCL_OK; 963 } else { 964 Tcl_AppendResult(interp, "Error getting source data", (char *) NULL); 965 AEDisposeDesc(&resultingSourceData); 966 return TCL_ERROR; 967 } 968} 969 970/* 971 *---------------------------------------------------------------------- 972 * 973 * tclOSADeleteCmd -- 974 * 975 * This implements the Delete subcommand of the Component command. 976 * 977 * Results: 978 * A standard Tcl result. 979 * 980 * Side Effects: 981 * Deletes a script from the script list of the given component. 982 * Removes all references to the script, and frees the memory 983 * associated with it. 984 * 985 *---------------------------------------------------------------------- 986 */ 987 988static int 989tclOSADeleteCmd( 990 Tcl_Interp *interp, 991 tclOSAComponent *OSAComponent, 992 int argc, 993 CONST char **argv) 994{ 995 char c,*errMsg = NULL; 996 int length; 997 998 if (argc < 4) { 999 Tcl_AppendResult(interp, "Wrong # of arguments, should be \"", 1000 argv[0], " ", argv[1], " what scriptName", (char *) NULL); 1001 return TCL_ERROR; 1002 } 1003 1004 c = *argv[2]; 1005 length = strlen(argv[2]); 1006 if (c == 'c' && strncmp(argv[2], "context", length) == 0) { 1007 if (strcmp(argv[3], "global") == 0) { 1008 Tcl_AppendResult(interp, "You cannot delete the global context", 1009 (char *) NULL); 1010 return TCL_ERROR; 1011 } else if (tclOSADeleteContext(OSAComponent, argv[3]) != TCL_OK) { 1012 Tcl_AppendResult(interp, "Error deleting script \"", argv[2], 1013 "\": ", errMsg, (char *) NULL); 1014 ckfree(errMsg); 1015 return TCL_ERROR; 1016 } 1017 } else if (c == 's' && strncmp(argv[2], "script", length) == 0) { 1018 if (tclOSADeleteScript(OSAComponent, argv[3], errMsg) != TCL_OK) { 1019 Tcl_AppendResult(interp, "Error deleting script \"", argv[3], 1020 "\": ", errMsg, (char *) NULL); 1021 ckfree(errMsg); 1022 return TCL_ERROR; 1023 } 1024 } else { 1025 Tcl_AppendResult(interp,"Unknown value ", argv[2], 1026 " should be one of ", 1027 "\"context\" or \"script\".", 1028 (char *) NULL ); 1029 return TCL_ERROR; 1030 } 1031 return TCL_OK; 1032} 1033 1034/* 1035 *---------------------------------------------------------------------- 1036 * 1037 * tclOSAExecuteCmd -- 1038 * 1039 * This implements the execute subcommand of the component command. 1040 * 1041 * Results: 1042 * A standard Tcl result. 1043 * 1044 * Side effects: 1045 * Executes the given script data, and sets interp's result to 1046 * the OSA component's return value. 1047 * 1048 *---------------------------------------------------------------------- 1049 */ 1050 1051static int 1052tclOSAExecuteCmd( 1053 Tcl_Interp *interp, 1054 tclOSAComponent *OSAComponent, 1055 int argc, 1056 CONST char **argv) 1057{ 1058 int tclError = TCL_OK; 1059 char c,buffer[32]; 1060 AEDesc scrptDesc = { typeNull, NULL }; 1061 long modeFlags = kOSAModeCanInteract; 1062 OSAID resultID = kOSANullScript, 1063 contextID = kOSANullScript; 1064 Tcl_DString scrptData; 1065 OSAError osaErr = noErr; 1066 1067 if (argc == 2) { 1068 Tcl_AppendResult(interp, 1069 "Error, no script data for \"", argv[0], 1070 " run\"", (char *) NULL); 1071 return TCL_ERROR; 1072 } 1073 1074 argv += 2; 1075 argc -= 2; 1076 1077 /* 1078 * Set the context to the global context by default. 1079 * Then parse the argument list for switches 1080 */ 1081 tclOSAGetContextID(OSAComponent, "global", &contextID); 1082 1083 while (argc > 0) { 1084 1085 if (*argv[0] == '-') { 1086 c = *(argv[0] + 1); 1087 1088 /* 1089 * "--" is the only switch that has no value. 1090 */ 1091 1092 if (c == '-' && *(argv[0] + 2) == '\0') { 1093 argv += 1; 1094 argc--; 1095 break; 1096 } 1097 1098 /* 1099 * So we can check here for a switch with no value. 1100 */ 1101 1102 if (argc == 1) { 1103 Tcl_AppendResult(interp, 1104 "Error, no value given for switch ", 1105 argv[0], (char *) NULL); 1106 return TCL_ERROR; 1107 } 1108 1109 if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) { 1110 if (tclOSAGetContextID(OSAComponent, 1111 argv[1], &contextID) == TCL_OK) { 1112 } else { 1113 Tcl_AppendResult(interp, "Script context \"", 1114 argv[1], "\" not found", (char *) NULL); 1115 return TCL_ERROR; 1116 } 1117 } else { 1118 Tcl_AppendResult(interp, "Error, invalid switch ", argv[0], 1119 " should be \"-context\"", (char *) NULL); 1120 return TCL_ERROR; 1121 } 1122 1123 argv += 2; 1124 argc -= 2; 1125 } else { 1126 break; 1127 } 1128 } 1129 1130 if (argc == 0) { 1131 Tcl_AppendResult(interp, "Error, no script data", (char *) NULL); 1132 return TCL_ERROR; 1133 } 1134 1135 if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) { 1136 Tcl_DStringResult(interp, &scrptData); 1137 AEDisposeDesc(&scrptDesc); 1138 return TCL_ERROR; 1139 } 1140 /* 1141 * Now try to compile and run, but check to make sure the 1142 * component supports the one shot deal 1143 */ 1144 if (OSAComponent->componentFlags && kOSASupportsConvenience) { 1145 osaErr = OSACompileExecute(OSAComponent->theComponent, 1146 &scrptDesc, contextID, modeFlags, &resultID); 1147 } else { 1148 /* 1149 * If not, we have to do this ourselves 1150 */ 1151 if (OSAComponent->componentFlags && kOSASupportsCompiling) { 1152 OSAID compiledID = kOSANullScript; 1153 osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc, 1154 modeFlags, &compiledID); 1155 if (osaErr == noErr) { 1156 osaErr = OSAExecute(OSAComponent->theComponent, compiledID, 1157 contextID, modeFlags, &resultID); 1158 } 1159 OSADispose(OSAComponent->theComponent, compiledID); 1160 } else { 1161 /* 1162 * The scripting component had better be able to load text data... 1163 */ 1164 OSAID loadedID = kOSANullScript; 1165 1166 scrptDesc.descriptorType = OSAComponent->languageID; 1167 osaErr = OSALoad(OSAComponent->theComponent, &scrptDesc, 1168 modeFlags, &loadedID); 1169 if (osaErr == noErr) { 1170 OSAExecute(OSAComponent->theComponent, loadedID, 1171 contextID, modeFlags, &resultID); 1172 } 1173 OSADispose(OSAComponent->theComponent, loadedID); 1174 } 1175 } 1176 if (osaErr == errOSAScriptError) { 1177 tclOSAASError(interp, OSAComponent->theComponent, 1178 Tcl_DStringValue(&scrptData)); 1179 tclError = TCL_ERROR; 1180 } else if (osaErr != noErr) { 1181 sprintf(buffer, "Error #%-6ld compiling script", (long)osaErr); 1182 Tcl_AppendResult(interp, buffer, (char *) NULL); 1183 tclError = TCL_ERROR; 1184 } else { 1185 tclOSAResultFromID(interp, OSAComponent->theComponent, resultID); 1186 osaErr = OSADispose(OSAComponent->theComponent, resultID); 1187 tclError = TCL_OK; 1188 } 1189 1190 Tcl_DStringFree(&scrptData); 1191 AEDisposeDesc(&scrptDesc); 1192 1193 return tclError; 1194} 1195 1196/* 1197 *---------------------------------------------------------------------- 1198 * 1199 * tclOSAInfoCmd -- 1200 * 1201 * This implements the Info subcommand of the component command 1202 * 1203 * Results: 1204 * A standard Tcl result. 1205 * 1206 * Side effects: 1207 * Info on scripts and contexts. See the user documentation for details. 1208 * 1209 *---------------------------------------------------------------------- 1210 */ 1211static int 1212tclOSAInfoCmd( 1213 Tcl_Interp *interp, 1214 tclOSAComponent *OSAComponent, 1215 int argc, 1216 CONST char **argv) 1217{ 1218 char c; 1219 int length; 1220 Tcl_DString theResult; 1221 1222 if (argc == 2) { 1223 Tcl_AppendResult(interp, "Wrong # of arguments, should be \"", 1224 argv[0], " ", argv[1], " what \"", (char *) NULL ); 1225 return TCL_ERROR; 1226 } 1227 1228 c = *argv[2]; 1229 length = strlen(argv[2]); 1230 if (c == 's' && strncmp(argv[2], "scripts", length) == 0) { 1231 Tcl_DStringInit(&theResult); 1232 if (argc == 3) { 1233 getSortedHashKeys(&OSAComponent->scriptTable, (char *) NULL, 1234 &theResult); 1235 } else if (argc == 4) { 1236 getSortedHashKeys(&OSAComponent->scriptTable, argv[3], &theResult); 1237 } else { 1238 Tcl_AppendResult(interp, "Error: wrong # of arguments,", 1239 " should be \"", argv[0], " ", argv[1], " ", 1240 argv[2], " ?pattern?", (char *) NULL); 1241 return TCL_ERROR; 1242 } 1243 Tcl_DStringResult(interp, &theResult); 1244 return TCL_OK; 1245 } else if (c == 'c' && strncmp(argv[2], "contexts", length) == 0) { 1246 Tcl_DStringInit(&theResult); 1247 if (argc == 3) { 1248 getSortedHashKeys(&OSAComponent->contextTable, (char *) NULL, 1249 &theResult); 1250 } else if (argc == 4) { 1251 getSortedHashKeys(&OSAComponent->contextTable, 1252 argv[3], &theResult); 1253 } else { 1254 Tcl_AppendResult(interp, "Error: wrong # of arguments for ,", 1255 " should be \"", argv[0], " ", argv[1], " ", 1256 argv[2], " ?pattern?", (char *) NULL); 1257 return TCL_ERROR; 1258 } 1259 Tcl_DStringResult(interp, &theResult); 1260 return TCL_OK; 1261 } else if (c == 'l' && strncmp(argv[2], "language", length) == 0) { 1262 Tcl_SetResult(interp, OSAComponent->languageName, TCL_STATIC); 1263 return TCL_OK; 1264 } else { 1265 Tcl_AppendResult(interp, "Unknown argument \"", argv[2], 1266 "\" for \"", argv[0], " info \", should be one of ", 1267 "\"scripts\" \"language\", or \"contexts\"", 1268 (char *) NULL); 1269 return TCL_ERROR; 1270 } 1271} 1272 1273/* 1274 *---------------------------------------------------------------------- 1275 * 1276 * tclOSALoadCmd -- 1277 * 1278 * This is the load subcommand for the Component Command 1279 * 1280 * 1281 * Results: 1282 * A standard Tcl result. 1283 * 1284 * Side effects: 1285 * Loads script data from the given file, creates a new context 1286 * for it, and sets interp's result to the name of the new context. 1287 * 1288 *---------------------------------------------------------------------- 1289 */ 1290 1291static int 1292tclOSALoadCmd( 1293 Tcl_Interp *interp, 1294 tclOSAComponent *OSAComponent, 1295 int argc, 1296 CONST char **argv) 1297{ 1298 int resID = 128; 1299 char c, autoName[24], 1300 *contextName = NULL, *scriptName = NULL; 1301 CONST char *resName = NULL; 1302 OSAID resultID = kOSANullScript; 1303 long scptInfo; 1304 1305 autoName[0] = '\0'; 1306 scriptName = autoName; 1307 contextName = autoName; 1308 1309 if (argc == 2) { 1310 Tcl_AppendResult(interp, 1311 "Error, no data for \"", argv[0], " ", argv[1], 1312 "\"", (char *) NULL); 1313 return TCL_ERROR; 1314 } 1315 1316 argv += 2; 1317 argc -= 2; 1318 1319 /* 1320 * Do the argument parsing. 1321 */ 1322 1323 while (argc > 0) { 1324 1325 if (*argv[0] == '-') { 1326 c = *(argv[0] + 1); 1327 1328 /* 1329 * "--" is the only switch that has no value. 1330 */ 1331 1332 if (c == '-' && *(argv[0] + 2) == '\0') { 1333 argv += 1; 1334 argc--; 1335 break; 1336 } 1337 1338 /* 1339 * So we can check here a switch with no value. 1340 */ 1341 1342 if (argc == 1) { 1343 Tcl_AppendResult(interp, "Error, no value given for switch ", 1344 argv[0], (char *) NULL); 1345 return TCL_ERROR; 1346 } 1347 1348 if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) { 1349 resName = argv[1]; 1350 } else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) { 1351 if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) { 1352 Tcl_AppendResult(interp, 1353 "Error getting resource ID", (char *) NULL); 1354 return TCL_ERROR; 1355 } 1356 } else { 1357 Tcl_AppendResult(interp, "Error, invalid switch ", argv[0], 1358 " should be \"--\", \"-rsrcname\" or \"-rsrcid\"", 1359 (char *) NULL); 1360 return TCL_ERROR; 1361 } 1362 1363 argv += 2; 1364 argc -= 2; 1365 } else { 1366 break; 1367 } 1368 } 1369 /* 1370 * Ok, now we have the options, so we can load the resource, 1371 */ 1372 if (argc == 0) { 1373 Tcl_AppendResult(interp, "Error, no filename given", (char *) NULL); 1374 return TCL_ERROR; 1375 } 1376 1377 if (tclOSALoad(interp, OSAComponent, resName, resID, 1378 argv[0], &resultID) != TCL_OK) { 1379 Tcl_AppendResult(interp, "Error in load command", (char *) NULL); 1380 return TCL_ERROR; 1381 } 1382 1383 /* 1384 * Now find out whether we have a script, or a script context. 1385 */ 1386 1387 OSAGetScriptInfo(OSAComponent->theComponent, resultID, 1388 kOSAScriptIsTypeScriptContext, &scptInfo); 1389 1390 if (scptInfo) { 1391 autoName[0] = '\0'; 1392 tclOSAAddContext(OSAComponent, autoName, resultID); 1393 1394 Tcl_SetResult(interp, autoName, TCL_VOLATILE); 1395 } else { 1396 /* 1397 * For a script, we return the script name 1398 */ 1399 autoName[0] = '\0'; 1400 tclOSAAddScript(OSAComponent, autoName, kOSAModeCanInteract, resultID); 1401 Tcl_SetResult(interp, autoName, TCL_VOLATILE); 1402 } 1403 return TCL_OK; 1404} 1405 1406/* 1407 *---------------------------------------------------------------------- 1408 * 1409 * tclOSARunCmd -- 1410 * 1411 * This implements the run subcommand of the component command 1412 * 1413 * Results: 1414 * A standard Tcl result. 1415 * 1416 * Side effects: 1417 * Runs the given compiled script, and returns the OSA 1418 * component's result. 1419 * 1420 *---------------------------------------------------------------------- 1421 */ 1422 1423static int 1424tclOSARunCmd( 1425 Tcl_Interp *interp, 1426 tclOSAComponent *OSAComponent, 1427 int argc, 1428 CONST char **argv) 1429{ 1430 int tclError = TCL_OK; 1431 char c; 1432 long modeFlags = kOSAModeCanInteract; 1433 OSAID resultID = kOSANullScript, 1434 contextID = kOSANullScript; 1435 OSErr sysErr = noErr; 1436 CONST char *componentName = argv[0]; 1437 OSAID scriptID; 1438 1439 if (argc == 2) { 1440 Tcl_AppendResult(interp, "Wrong # of arguments, should be \"", 1441 argv[0], " ", argv[1], " scriptName", (char *) NULL); 1442 return TCL_ERROR; 1443 } 1444 1445 /* 1446 * Set the context to the global context for this component, 1447 * as a default 1448 */ 1449 if (tclOSAGetContextID(OSAComponent, "global", &contextID) != TCL_OK) { 1450 Tcl_AppendResult(interp, 1451 "Could not find the global context for component ", 1452 OSAComponent->theName, (char *) NULL ); 1453 return TCL_ERROR; 1454 } 1455 1456 /* 1457 * Now parse the argument list for switches 1458 */ 1459 argv += 2; 1460 argc -= 2; 1461 1462 while (argc > 0) { 1463 if (*argv[0] == '-') { 1464 c = *(argv[0] + 1); 1465 /* 1466 * "--" is the only switch that has no value 1467 */ 1468 if (c == '-' && *(argv[0] + 2) == '\0') { 1469 argv += 1; 1470 argc--; 1471 break; 1472 } 1473 1474 /* 1475 * So we can check here for a switch with no value. 1476 */ 1477 if (argc == 1) { 1478 Tcl_AppendResult(interp, "Error, no value given for switch ", 1479 argv[0], (char *) NULL); 1480 return TCL_ERROR; 1481 } 1482 1483 if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) { 1484 if (argc == 1) { 1485 Tcl_AppendResult(interp, 1486 "Error - no context provided for the -context switch", 1487 (char *) NULL); 1488 return TCL_ERROR; 1489 } else if (tclOSAGetContextID(OSAComponent, 1490 argv[1], &contextID) == TCL_OK) { 1491 } else { 1492 Tcl_AppendResult(interp, "Script context \"", argv[1], 1493 "\" not found", (char *) NULL); 1494 return TCL_ERROR; 1495 } 1496 } else { 1497 Tcl_AppendResult(interp, "Error, invalid switch ", argv[0], 1498 " for ", componentName, 1499 " should be \"-context\"", (char *) NULL); 1500 return TCL_ERROR; 1501 } 1502 argv += 2; 1503 argc -= 2; 1504 } else { 1505 break; 1506 } 1507 } 1508 1509 if (tclOSAGetScriptID(OSAComponent, argv[0], &scriptID) != TCL_OK) { 1510 if (tclOSAGetContextID(OSAComponent, argv[0], &scriptID) != TCL_OK) { 1511 Tcl_AppendResult(interp, "Could not find script \"", 1512 argv[2], "\"", (char *) NULL); 1513 return TCL_ERROR; 1514 } 1515 } 1516 1517 sysErr = OSAExecute(OSAComponent->theComponent, 1518 scriptID, contextID, modeFlags, &resultID); 1519 1520 if (sysErr == errOSAScriptError) { 1521 tclOSAASError(interp, OSAComponent->theComponent, (char *) NULL); 1522 tclError = TCL_ERROR; 1523 } else if (sysErr != noErr) { 1524 char buffer[32]; 1525 sprintf(buffer, "Error #%6.6d encountered in run", sysErr); 1526 Tcl_SetResult(interp, buffer, TCL_VOLATILE); 1527 tclError = TCL_ERROR; 1528 } else { 1529 tclOSAResultFromID(interp, OSAComponent->theComponent, resultID ); 1530 } 1531 OSADispose(OSAComponent->theComponent, resultID); 1532 1533 return tclError; 1534} 1535 1536/* 1537 *---------------------------------------------------------------------- 1538 * 1539 * tclOSAStoreCmd -- 1540 * 1541 * This implements the store subcommand of the component command 1542 * 1543 * Results: 1544 * A standard Tcl result. 1545 * 1546 * Side effects: 1547 * Runs the given compiled script, and returns the OSA 1548 * component's result. 1549 * 1550 *---------------------------------------------------------------------- 1551 */ 1552 1553static int 1554tclOSAStoreCmd( 1555 Tcl_Interp *interp, 1556 tclOSAComponent *OSAComponent, 1557 int argc, 1558 CONST char **argv) 1559{ 1560 int tclError = TCL_OK, resID = 128; 1561 char c; 1562 CONST char *resName = NULL; 1563 1564 if (argc == 2) { 1565 Tcl_AppendResult(interp, "Error, no data for \"", argv[0], 1566 " ",argv[1], "\"", (char *) NULL); 1567 return TCL_ERROR; 1568 } 1569 1570 argv += 2; 1571 argc -= 2; 1572 1573 /* 1574 * Do the argument parsing 1575 */ 1576 1577 while (argc > 0) { 1578 if (*argv[0] == '-') { 1579 c = *(argv[0] + 1); 1580 1581 /* 1582 * "--" is the only switch that has no value 1583 */ 1584 if (c == '-' && *(argv[0] + 2) == '\0') { 1585 argv += 1; 1586 argc--; 1587 break; 1588 } 1589 1590 /* 1591 * So we can check here a switch with no value. 1592 */ 1593 if (argc == 1) { 1594 Tcl_AppendResult(interp, 1595 "Error, no value given for switch ", 1596 argv[0], (char *) NULL); 1597 return TCL_ERROR; 1598 } 1599 1600 if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) { 1601 resName = argv[1]; 1602 } else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) { 1603 if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) { 1604 Tcl_AppendResult(interp, 1605 "Error getting resource ID", (char *) NULL); 1606 return TCL_ERROR; 1607 } 1608 } else { 1609 Tcl_AppendResult(interp, "Error, invalid switch ", argv[0], 1610 " should be \"--\", \"-rsrcname\" or \"-rsrcid\"", 1611 (char *) NULL); 1612 return TCL_ERROR; 1613 } 1614 1615 argv += 2; 1616 argc -= 2; 1617 } else { 1618 break; 1619 } 1620 } 1621 /* 1622 * Ok, now we have the options, so we can load the resource, 1623 */ 1624 if (argc != 2) { 1625 Tcl_AppendResult(interp, "Error, wrong # of arguments, should be ", 1626 argv[0], " ", argv[1], "?option flag? scriptName fileName", 1627 (char *) NULL); 1628 return TCL_ERROR; 1629 } 1630 1631 if (tclOSAStore(interp, OSAComponent, resName, resID, 1632 argv[0], argv[1]) != TCL_OK) { 1633 Tcl_AppendResult(interp, "Error in load command", (char *) NULL); 1634 return TCL_ERROR; 1635 } else { 1636 Tcl_ResetResult(interp); 1637 tclError = TCL_OK; 1638 } 1639 1640 return tclError; 1641} 1642 1643/* 1644 *---------------------------------------------------------------------- 1645 * 1646 * tclOSAMakeNewComponent -- 1647 * 1648 * Makes a command cmdName to represent a new connection to the 1649 * OSA component with componentSubType scriptSubtype. 1650 * 1651 * Results: 1652 * Returns the tclOSAComponent structure for the connection. 1653 * 1654 * Side Effects: 1655 * Adds a new element to the component table. If there is an 1656 * error, then the result of the Tcl interpreter interp is set 1657 * to an appropriate error message. 1658 * 1659 *---------------------------------------------------------------------- 1660 */ 1661 1662tclOSAComponent * 1663tclOSAMakeNewComponent( 1664 Tcl_Interp *interp, 1665 char *cmdName, 1666 char *languageName, 1667 OSType scriptSubtype, 1668 long componentFlags) 1669{ 1670 char buffer[32]; 1671 OSAID globalContext; 1672 char global[] = "global"; 1673 int nbytes; 1674 ComponentDescription requestedComponent = { 1675 kOSAComponentType, 1676 (OSType) 0, 1677 (OSType) 0, 1678 (long int) 0, 1679 (long int) 0 1680 }; 1681 Tcl_HashTable *ComponentTable; 1682 Component foundComponent = NULL; 1683 OSAActiveUPP myActiveProcUPP; 1684 1685 tclOSAComponent *newComponent; 1686 Tcl_HashEntry *hashEntry; 1687 int newPtr; 1688 1689 requestedComponent.componentSubType = scriptSubtype; 1690 nbytes = sizeof(tclOSAComponent); 1691 newComponent = (tclOSAComponent *) ckalloc(sizeof(tclOSAComponent)); 1692 if (newComponent == NULL) { 1693 goto CleanUp; 1694 } 1695 1696 foundComponent = FindNextComponent(0, &requestedComponent); 1697 if (foundComponent == 0) { 1698 Tcl_AppendResult(interp, 1699 "Could not find component of requested type", (char *) NULL); 1700 goto CleanUp; 1701 } 1702 1703 newComponent->theComponent = OpenComponent(foundComponent); 1704 1705 if (newComponent->theComponent == NULL) { 1706 Tcl_AppendResult(interp, 1707 "Could not open component of the requested type", 1708 (char *) NULL); 1709 goto CleanUp; 1710 } 1711 1712 newComponent->languageName = (char *) ckalloc(strlen(languageName) + 1); 1713 strcpy(newComponent->languageName,languageName); 1714 1715 newComponent->componentFlags = componentFlags; 1716 1717 newComponent->theInterp = interp; 1718 1719 Tcl_InitHashTable(&newComponent->contextTable, TCL_STRING_KEYS); 1720 Tcl_InitHashTable(&newComponent->scriptTable, TCL_STRING_KEYS); 1721 1722 if (tclOSAMakeContext(newComponent, global, &globalContext) != TCL_OK) { 1723 sprintf(buffer, "%-6.6ld", globalContext); 1724 Tcl_AppendResult(interp, "Error ", buffer, " making ", global, 1725 " context.", (char *) NULL); 1726 goto CleanUp; 1727 } 1728 1729 newComponent->languageID = scriptSubtype; 1730 1731 newComponent->theName = (char *) ckalloc(strlen(cmdName) + 1 ); 1732 strcpy(newComponent->theName, cmdName); 1733 1734 Tcl_CreateCommand(interp, newComponent->theName, Tcl_OSAComponentCmd, 1735 (ClientData) newComponent, tclOSAClose); 1736 1737 /* 1738 * Register the new component with the component table 1739 */ 1740 1741 ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp, 1742 "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL); 1743 1744 if (ComponentTable == NULL) { 1745 Tcl_AppendResult(interp, "Error, could not get the Component Table", 1746 " from the Associated data.", (char *) NULL); 1747 return (tclOSAComponent *) NULL; 1748 } 1749 1750 hashEntry = Tcl_CreateHashEntry(ComponentTable, 1751 newComponent->theName, &newPtr); 1752 Tcl_SetHashValue(hashEntry, (ClientData) newComponent); 1753 1754 /* 1755 * Set the active proc to call Tcl_DoOneEvent() while idle 1756 */ 1757 if (OSAGetActiveProc(newComponent->theComponent, 1758 &newComponent->defActiveProc, &newComponent->defRefCon) != noErr ) { 1759 /* TODO -- clean up here... */ 1760 } 1761 1762 myActiveProcUPP = NewOSAActiveUPP(TclOSAActiveProc); 1763 OSASetActiveProc(newComponent->theComponent, 1764 myActiveProcUPP, (long) newComponent); 1765 return newComponent; 1766 1767 CleanUp: 1768 1769 ckfree((char *) newComponent); 1770 return (tclOSAComponent *) NULL; 1771} 1772 1773/* 1774 *---------------------------------------------------------------------- 1775 * 1776 * tclOSAClose -- 1777 * 1778 * This procedure closes the connection to an OSA component, and 1779 * deletes all the script and context data associated with it. 1780 * It is the command deletion callback for the component's command. 1781 * 1782 * Results: 1783 * None 1784 * 1785 * Side effects: 1786 * Closes the connection, and releases all the script data. 1787 * 1788 *---------------------------------------------------------------------- 1789 */ 1790 1791void 1792tclOSAClose( 1793 ClientData clientData) 1794{ 1795 tclOSAComponent *theComponent = (tclOSAComponent *) clientData; 1796 Tcl_HashEntry *hashEntry; 1797 Tcl_HashSearch search; 1798 tclOSAScript *theScript; 1799 Tcl_HashTable *ComponentTable; 1800 1801 /* 1802 * Delete the context and script tables 1803 * the memory for the language name, and 1804 * the hash entry. 1805 */ 1806 1807 for (hashEntry = Tcl_FirstHashEntry(&theComponent->scriptTable, &search); 1808 hashEntry != NULL; 1809 hashEntry = Tcl_NextHashEntry(&search)) { 1810 1811 theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry); 1812 OSADispose(theComponent->theComponent, theScript->scriptID); 1813 ckfree((char *) theScript); 1814 Tcl_DeleteHashEntry(hashEntry); 1815 } 1816 1817 for (hashEntry = Tcl_FirstHashEntry(&theComponent->contextTable, &search); 1818 hashEntry != NULL; 1819 hashEntry = Tcl_NextHashEntry(&search)) { 1820 1821 Tcl_DeleteHashEntry(hashEntry); 1822 } 1823 1824 ckfree(theComponent->languageName); 1825 ckfree(theComponent->theName); 1826 1827 /* 1828 * Finally close the component 1829 */ 1830 1831 CloseComponent(theComponent->theComponent); 1832 1833 ComponentTable = (Tcl_HashTable *) 1834 Tcl_GetAssocData(theComponent->theInterp, 1835 "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL); 1836 1837 if (ComponentTable == NULL) { 1838 panic("Error, could not get the Component Table from the Associated data."); 1839 } 1840 1841 hashEntry = Tcl_FindHashEntry(ComponentTable, theComponent->theName); 1842 if (hashEntry != NULL) { 1843 Tcl_DeleteHashEntry(hashEntry); 1844 } 1845 1846 ckfree((char *) theComponent); 1847} 1848 1849/* 1850 *---------------------------------------------------------------------- 1851 * 1852 * tclOSAGetContextID -- 1853 * 1854 * This returns the context ID, given the component name. 1855 * 1856 * Results: 1857 * A context ID 1858 * 1859 * Side effects: 1860 * None 1861 * 1862 *---------------------------------------------------------------------- 1863 */ 1864 1865static int 1866tclOSAGetContextID( 1867 tclOSAComponent *theComponent, 1868 CONST char *contextName, 1869 OSAID *theContext) 1870{ 1871 Tcl_HashEntry *hashEntry; 1872 tclOSAContext *contextStruct; 1873 1874 if ((hashEntry = Tcl_FindHashEntry(&theComponent->contextTable, 1875 contextName)) == NULL ) { 1876 return TCL_ERROR; 1877 } else { 1878 contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry); 1879 *theContext = contextStruct->contextID; 1880 } 1881 return TCL_OK; 1882} 1883 1884/* 1885 *---------------------------------------------------------------------- 1886 * 1887 * tclOSAAddContext -- 1888 * 1889 * This adds the context ID, with the name contextName. If the 1890 * name is passed in as a NULL string, space is malloc'ed for the 1891 * string and a new name is made up, if the string is empty, you 1892 * must have allocated enough space ( 24 characters is fine) for 1893 * the name, which is made up and passed out. 1894 * 1895 * Results: 1896 * Nothing 1897 * 1898 * Side effects: 1899 * Adds the script context to the component's context table. 1900 * 1901 *---------------------------------------------------------------------- 1902 */ 1903 1904static void 1905tclOSAAddContext( 1906 tclOSAComponent *theComponent, 1907 char *contextName, 1908 const OSAID theContext) 1909{ 1910 static unsigned short contextIndex = 0; 1911 tclOSAContext *contextStruct; 1912 Tcl_HashEntry *hashEntry; 1913 int newPtr; 1914 1915 if (contextName == NULL) { 1916 contextName = ckalloc(16 + TCL_INTEGER_SPACE); 1917 sprintf(contextName, "OSAContext%d", contextIndex++); 1918 } else if (*contextName == '\0') { 1919 sprintf(contextName, "OSAContext%d", contextIndex++); 1920 } 1921 1922 hashEntry = Tcl_CreateHashEntry(&theComponent->contextTable, 1923 contextName, &newPtr); 1924 1925 contextStruct = (tclOSAContext *) ckalloc(sizeof(tclOSAContext)); 1926 contextStruct->contextID = theContext; 1927 Tcl_SetHashValue(hashEntry,(ClientData) contextStruct); 1928} 1929 1930/* 1931 *---------------------------------------------------------------------- 1932 * 1933 * tclOSADeleteContext -- 1934 * 1935 * This deletes the context struct, with the name contextName. 1936 * 1937 * Results: 1938 * A normal Tcl result 1939 * 1940 * Side effects: 1941 * Removes the script context to the component's context table, 1942 * and deletes the data associated with it. 1943 * 1944 *---------------------------------------------------------------------- 1945 */ 1946 1947static int 1948tclOSADeleteContext( 1949 tclOSAComponent *theComponent, 1950 CONST char *contextName) 1951{ 1952 Tcl_HashEntry *hashEntry; 1953 tclOSAContext *contextStruct; 1954 1955 hashEntry = Tcl_FindHashEntry(&theComponent->contextTable, contextName); 1956 if (hashEntry == NULL) { 1957 return TCL_ERROR; 1958 } 1959 /* 1960 * Dispose of the script context data 1961 */ 1962 contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry); 1963 OSADispose(theComponent->theComponent,contextStruct->contextID); 1964 /* 1965 * Then the hash entry 1966 */ 1967 ckfree((char *) contextStruct); 1968 Tcl_DeleteHashEntry(hashEntry); 1969 return TCL_OK; 1970} 1971 1972/* 1973 *---------------------------------------------------------------------- 1974 * 1975 * tclOSAMakeContext -- 1976 * 1977 * This makes the context with name contextName, and returns the ID. 1978 * 1979 * Results: 1980 * A standard Tcl result 1981 * 1982 * Side effects: 1983 * Makes a new context, adds it to the context table, and returns 1984 * the new contextID in the variable theContext. 1985 * 1986 *---------------------------------------------------------------------- 1987 */ 1988 1989static int 1990tclOSAMakeContext( 1991 tclOSAComponent *theComponent, 1992 CONST char *contextName, 1993 OSAID *theContext) 1994{ 1995 AEDesc contextNameDesc = {typeNull, NULL}; 1996 OSAError osaErr = noErr; 1997 1998 AECreateDesc(typeChar, contextName, strlen(contextName), &contextNameDesc); 1999 osaErr = OSAMakeContext(theComponent->theComponent, &contextNameDesc, 2000 kOSANullScript, theContext); 2001 2002 AEDisposeDesc(&contextNameDesc); 2003 2004 if (osaErr == noErr) { 2005 char name[24]; 2006 strncpy(name, contextName, 23); 2007 name[23] = '\0'; 2008 tclOSAAddContext(theComponent, name, *theContext); 2009 } else { 2010 *theContext = (OSAID) osaErr; 2011 return TCL_ERROR; 2012 } 2013 2014 return TCL_OK; 2015} 2016 2017/* 2018 *---------------------------------------------------------------------- 2019 * 2020 * tclOSAStore -- 2021 * 2022 * This stores a script resource from the file named in fileName. 2023 * 2024 * Most of this routine is caged from the Tcl Source, from the 2025 * Tcl_MacSourceCmd routine. This is good, since it ensures this 2026 * follows the same convention for looking up files as Tcl. 2027 * 2028 * Returns 2029 * A standard Tcl result. 2030 * 2031 * Side Effects: 2032 * The given script data is stored in the file fileName. 2033 * 2034 *---------------------------------------------------------------------- 2035 */ 2036 2037int 2038tclOSAStore( 2039 Tcl_Interp *interp, 2040 tclOSAComponent *theComponent, 2041 CONST char *resourceName, 2042 int resourceNumber, 2043 CONST char *scriptName, 2044 CONST char *fileName) 2045{ 2046 Handle resHandle; 2047 Str255 rezName; 2048 int result = TCL_OK; 2049 short saveRef, fileRef = -1; 2050 char idStr[16 + TCL_INTEGER_SPACE]; 2051 FSSpec fileSpec; 2052 Tcl_DString ds, buffer; 2053 CONST char *nativeName; 2054 OSErr myErr = noErr; 2055 OSAID scriptID; 2056 Size scriptSize; 2057 AEDesc scriptData; 2058 2059 /* 2060 * First extract the script data 2061 */ 2062 2063 if (tclOSAGetScriptID(theComponent, scriptName, &scriptID) != TCL_OK ) { 2064 if (tclOSAGetContextID(theComponent, scriptName, &scriptID) 2065 != TCL_OK) { 2066 Tcl_AppendResult(interp, "Error getting script ", 2067 scriptName, (char *) NULL); 2068 return TCL_ERROR; 2069 } 2070 } 2071 2072 myErr = OSAStore(theComponent->theComponent, scriptID, 2073 typeOSAGenericStorage, kOSAModeNull, &scriptData); 2074 if (myErr != noErr) { 2075 sprintf(idStr, "%d", myErr); 2076 Tcl_AppendResult(interp, "Error #", idStr, 2077 " storing script ", scriptName, (char *) NULL); 2078 return TCL_ERROR; 2079 } 2080 2081 /* 2082 * Now try to open the output file 2083 */ 2084 2085 saveRef = CurResFile(); 2086 2087 if (fileName != NULL) { 2088 OSErr err; 2089 2090 if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) { 2091 return TCL_ERROR; 2092 } 2093 nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer), 2094 Tcl_DStringLength(&buffer), &ds); 2095 err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec); 2096 2097 Tcl_DStringFree(&ds); 2098 Tcl_DStringFree(&buffer); 2099 if ((err != noErr) && (err != fnfErr)) { 2100 Tcl_AppendResult(interp, 2101 "Error getting a location for the file: \"", 2102 fileName, "\".", NULL); 2103 return TCL_ERROR; 2104 } 2105 2106 FSpCreateResFile(&fileSpec, 2107 'WiSH', 'osas', smSystemScript); 2108 myErr = ResError(); 2109 2110 if ((myErr != noErr) && (myErr != dupFNErr)) { 2111 sprintf(idStr, "%d", myErr); 2112 Tcl_AppendResult(interp, "Error #", idStr, 2113 " creating new resource file ", fileName, (char *) NULL); 2114 result = TCL_ERROR; 2115 goto rezEvalCleanUp; 2116 } 2117 2118 fileRef = FSpOpenResFile(&fileSpec, fsRdWrPerm); 2119 if (fileRef == -1) { 2120 Tcl_AppendResult(interp, "Error reading the file: \"", 2121 fileName, "\".", NULL); 2122 result = TCL_ERROR; 2123 goto rezEvalCleanUp; 2124 } 2125 UseResFile(fileRef); 2126 } else { 2127 /* 2128 * The default behavior will search through all open resource files. 2129 * This may not be the behavior you desire. If you want the behavior 2130 * of this call to *only* search the application resource fork, you 2131 * must call UseResFile at this point to set it to the application 2132 * file. This means you must have already obtained the application's 2133 * fileRef when the application started up. 2134 */ 2135 } 2136 2137 /* 2138 * Load the resource by name 2139 */ 2140 if (resourceName != NULL) { 2141 strcpy((char *) rezName + 1, resourceName); 2142 rezName[0] = strlen(resourceName); 2143 resHandle = Get1NamedResource('scpt', rezName); 2144 myErr = ResError(); 2145 if (resHandle == NULL) { 2146 /* 2147 * These signify either the resource or the resource 2148 * type were not found 2149 */ 2150 if (myErr == resNotFound || myErr == noErr) { 2151 short uniqueID; 2152 while ((uniqueID = Unique1ID('scpt') ) < 128) {} 2153 AddResource(scriptData.dataHandle, 'scpt', uniqueID, rezName); 2154 WriteResource(resHandle); 2155 result = TCL_OK; 2156 goto rezEvalCleanUp; 2157 } else { 2158 /* 2159 * This means there was some other error, for now 2160 * I just bag out. 2161 */ 2162 sprintf(idStr, "%d", myErr); 2163 Tcl_AppendResult(interp, "Error #", idStr, 2164 " opening scpt resource named ", resourceName, 2165 " in file ", fileName, (char *) NULL); 2166 result = TCL_ERROR; 2167 goto rezEvalCleanUp; 2168 } 2169 } 2170 /* 2171 * Or ID 2172 */ 2173 } else { 2174 resHandle = Get1Resource('scpt', resourceNumber); 2175 rezName[0] = 0; 2176 rezName[1] = '\0'; 2177 myErr = ResError(); 2178 if (resHandle == NULL) { 2179 /* 2180 * These signify either the resource or the resource 2181 * type were not found 2182 */ 2183 if (myErr == resNotFound || myErr == noErr) { 2184 AddResource(scriptData.dataHandle, 'scpt', 2185 resourceNumber, rezName); 2186 WriteResource(resHandle); 2187 result = TCL_OK; 2188 goto rezEvalCleanUp; 2189 } else { 2190 /* 2191 * This means there was some other error, for now 2192 * I just bag out */ 2193 sprintf(idStr, "%d", myErr); 2194 Tcl_AppendResult(interp, "Error #", idStr, 2195 " opening scpt resource named ", resourceName, 2196 " in file ", fileName,(char *) NULL); 2197 result = TCL_ERROR; 2198 goto rezEvalCleanUp; 2199 } 2200 } 2201 } 2202 2203 /* 2204 * We get to here if the resource exists 2205 * we just copy into it... 2206 */ 2207 2208 scriptSize = GetHandleSize(scriptData.dataHandle); 2209 SetHandleSize(resHandle, scriptSize); 2210 HLock(scriptData.dataHandle); 2211 HLock(resHandle); 2212 BlockMove(*scriptData.dataHandle, *resHandle,scriptSize); 2213 HUnlock(scriptData.dataHandle); 2214 HUnlock(resHandle); 2215 ChangedResource(resHandle); 2216 WriteResource(resHandle); 2217 result = TCL_OK; 2218 goto rezEvalCleanUp; 2219 2220 sprintf(idStr, "ID=%d", resourceNumber); 2221 Tcl_AppendResult(interp, "The resource \"", 2222 (resourceName != NULL ? resourceName : idStr), 2223 "\" could not be loaded from ", 2224 (fileName != NULL ? fileName : "application"), 2225 ".", NULL); 2226 2227 rezEvalCleanUp: 2228 if (fileRef != -1) { 2229 CloseResFile(fileRef); 2230 } 2231 2232 UseResFile(saveRef); 2233 2234 return result; 2235} 2236 2237/*---------------------------------------------------------------------- 2238 * 2239 * tclOSALoad -- 2240 * 2241 * This loads a script resource from the file named in fileName. 2242 * Most of this routine is caged from the Tcl Source, from the 2243 * Tcl_MacSourceCmd routine. This is good, since it ensures this 2244 * follows the same convention for looking up files as Tcl. 2245 * 2246 * Returns 2247 * A standard Tcl result. 2248 * 2249 * Side Effects: 2250 * A new script element is created from the data in the file. 2251 * The script ID is passed out in the variable resultID. 2252 * 2253 *---------------------------------------------------------------------- 2254 */ 2255 2256int 2257tclOSALoad( 2258 Tcl_Interp *interp, 2259 tclOSAComponent *theComponent, 2260 CONST char *resourceName, 2261 int resourceNumber, 2262 CONST char *fileName, 2263 OSAID *resultID) 2264{ 2265 Handle sourceData; 2266 Str255 rezName; 2267 int result = TCL_OK; 2268 short saveRef, fileRef = -1; 2269 char idStr[16 + TCL_INTEGER_SPACE]; 2270 FSSpec fileSpec; 2271 Tcl_DString ds, buffer; 2272 CONST char *nativeName; 2273 2274 saveRef = CurResFile(); 2275 2276 if (fileName != NULL) { 2277 OSErr err; 2278 2279 if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) { 2280 return TCL_ERROR; 2281 } 2282 nativeName = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer), 2283 Tcl_DStringLength(&buffer), &ds); 2284 err = FSpLocationFromPath(strlen(nativeName), nativeName, &fileSpec); 2285 Tcl_DStringFree(&ds); 2286 Tcl_DStringFree(&buffer); 2287 if (err != noErr) { 2288 Tcl_AppendResult(interp, "Error finding the file: \"", 2289 fileName, "\".", NULL); 2290 return TCL_ERROR; 2291 } 2292 2293 fileRef = FSpOpenResFile(&fileSpec, fsRdPerm); 2294 if (fileRef == -1) { 2295 Tcl_AppendResult(interp, "Error reading the file: \"", 2296 fileName, "\".", NULL); 2297 return TCL_ERROR; 2298 } 2299 UseResFile(fileRef); 2300 } else { 2301 /* 2302 * The default behavior will search through all open resource files. 2303 * This may not be the behavior you desire. If you want the behavior 2304 * of this call to *only* search the application resource fork, you 2305 * must call UseResFile at this point to set it to the application 2306 * file. This means you must have already obtained the application's 2307 * fileRef when the application started up. 2308 */ 2309 } 2310 2311 /* 2312 * Load the resource by name or ID 2313 */ 2314 if (resourceName != NULL) { 2315 strcpy((char *) rezName + 1, resourceName); 2316 rezName[0] = strlen(resourceName); 2317 sourceData = GetNamedResource('scpt', rezName); 2318 } else { 2319 sourceData = GetResource('scpt', (short) resourceNumber); 2320 } 2321 2322 if (sourceData == NULL) { 2323 result = TCL_ERROR; 2324 } else { 2325 AEDesc scriptDesc; 2326 OSAError osaErr; 2327 2328 scriptDesc.descriptorType = typeOSAGenericStorage; 2329 scriptDesc.dataHandle = sourceData; 2330 2331 osaErr = OSALoad(theComponent->theComponent, &scriptDesc, 2332 kOSAModeNull, resultID); 2333 2334 ReleaseResource(sourceData); 2335 2336 if (osaErr != noErr) { 2337 result = TCL_ERROR; 2338 goto rezEvalError; 2339 } 2340 2341 goto rezEvalCleanUp; 2342 } 2343 2344 rezEvalError: 2345 sprintf(idStr, "ID=%d", resourceNumber); 2346 Tcl_AppendResult(interp, "The resource \"", 2347 (resourceName != NULL ? resourceName : idStr), 2348 "\" could not be loaded from ", 2349 (fileName != NULL ? fileName : "application"), 2350 ".", NULL); 2351 2352 rezEvalCleanUp: 2353 if (fileRef != -1) { 2354 CloseResFile(fileRef); 2355 } 2356 2357 UseResFile(saveRef); 2358 2359 return result; 2360} 2361 2362/* 2363 *---------------------------------------------------------------------- 2364 * 2365 * tclOSAGetScriptID -- 2366 * 2367 * This returns the context ID, gibven the component name. 2368 * 2369 * Results: 2370 * A standard Tcl result 2371 * 2372 * Side effects: 2373 * Passes out the script ID in the variable scriptID. 2374 * 2375 *---------------------------------------------------------------------- 2376 */ 2377 2378static int 2379tclOSAGetScriptID( 2380 tclOSAComponent *theComponent, 2381 CONST char *scriptName, 2382 OSAID *scriptID) 2383{ 2384 tclOSAScript *theScript; 2385 2386 theScript = tclOSAGetScript(theComponent, scriptName); 2387 if (theScript == NULL) { 2388 return TCL_ERROR; 2389 } 2390 2391 *scriptID = theScript->scriptID; 2392 return TCL_OK; 2393} 2394 2395/* 2396 *---------------------------------------------------------------------- 2397 * 2398 * tclOSAAddScript -- 2399 * 2400 * This adds a script to theComponent's script table, with the 2401 * given name & ID. 2402 * 2403 * Results: 2404 * A standard Tcl result 2405 * 2406 * Side effects: 2407 * Adds an element to the component's script table. 2408 * 2409 *---------------------------------------------------------------------- 2410 */ 2411 2412static int 2413tclOSAAddScript( 2414 tclOSAComponent *theComponent, 2415 char *scriptName, 2416 long modeFlags, 2417 OSAID scriptID) 2418{ 2419 Tcl_HashEntry *hashEntry; 2420 int newPtr; 2421 static int scriptIndex = 0; 2422 tclOSAScript *theScript; 2423 2424 if (*scriptName == '\0') { 2425 sprintf(scriptName, "OSAScript%d", scriptIndex++); 2426 } 2427 2428 hashEntry = Tcl_CreateHashEntry(&theComponent->scriptTable, 2429 scriptName, &newPtr); 2430 if (newPtr == 0) { 2431 theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry); 2432 OSADispose(theComponent->theComponent, theScript->scriptID); 2433 } else { 2434 theScript = (tclOSAScript *) ckalloc(sizeof(tclOSAScript)); 2435 if (theScript == NULL) { 2436 return TCL_ERROR; 2437 } 2438 } 2439 2440 theScript->scriptID = scriptID; 2441 theScript->languageID = theComponent->languageID; 2442 theScript->modeFlags = modeFlags; 2443 2444 Tcl_SetHashValue(hashEntry,(ClientData) theScript); 2445 2446 return TCL_OK; 2447} 2448 2449/* 2450 *---------------------------------------------------------------------- 2451 * 2452 * tclOSAGetScriptID -- 2453 * 2454 * This returns the script structure, given the component and script name. 2455 * 2456 * Results: 2457 * A pointer to the script structure. 2458 * 2459 * Side effects: 2460 * None 2461 * 2462 *---------------------------------------------------------------------- 2463 */ 2464 2465static tclOSAScript * 2466tclOSAGetScript( 2467 tclOSAComponent *theComponent, 2468 CONST char *scriptName) 2469{ 2470 Tcl_HashEntry *hashEntry; 2471 2472 hashEntry = Tcl_FindHashEntry(&theComponent->scriptTable, scriptName); 2473 if (hashEntry == NULL) { 2474 return NULL; 2475 } 2476 2477 return (tclOSAScript *) Tcl_GetHashValue(hashEntry); 2478} 2479 2480/* 2481 *---------------------------------------------------------------------- 2482 * 2483 * tclOSADeleteScript -- 2484 * 2485 * This deletes the script given by scriptName. 2486 * 2487 * Results: 2488 * A standard Tcl result 2489 * 2490 * Side effects: 2491 * Deletes the script from the script table, and frees up the 2492 * resources associated with it. If there is an error, then 2493 * space for the error message is malloc'ed, and passed out in 2494 * the variable errMsg. 2495 * 2496 *---------------------------------------------------------------------- 2497 */ 2498 2499static int 2500tclOSADeleteScript( 2501 tclOSAComponent *theComponent, 2502 CONST char *scriptName, 2503 char *errMsg) 2504{ 2505 Tcl_HashEntry *hashEntry; 2506 tclOSAScript *scriptPtr; 2507 2508 hashEntry = Tcl_FindHashEntry(&theComponent->scriptTable, scriptName); 2509 if (hashEntry == NULL) { 2510 errMsg = ckalloc(17); 2511 strcpy(errMsg,"Script not found"); 2512 return TCL_ERROR; 2513 } 2514 2515 scriptPtr = (tclOSAScript *) Tcl_GetHashValue(hashEntry); 2516 OSADispose(theComponent->theComponent, scriptPtr->scriptID); 2517 ckfree((char *) scriptPtr); 2518 Tcl_DeleteHashEntry(hashEntry); 2519 return TCL_OK; 2520} 2521 2522/* 2523 *---------------------------------------------------------------------- 2524 * 2525 * TclOSAActiveProc -- 2526 * 2527 * This is passed to each component. It is run periodically 2528 * during script compilation and script execution. It in turn 2529 * calls Tcl_DoOneEvent to process the event queue. We also call 2530 * the default Active proc which will let the user cancel the script 2531 * by hitting Command-. 2532 * 2533 * Results: 2534 * A standard MacOS system error 2535 * 2536 * Side effects: 2537 * Any Tcl code may run while calling Tcl_DoOneEvent. 2538 * 2539 *---------------------------------------------------------------------- 2540 */ 2541 2542static pascal OSErr 2543TclOSAActiveProc( 2544 long refCon) 2545{ 2546 tclOSAComponent *theComponent = (tclOSAComponent *) refCon; 2547 2548 Tcl_DoOneEvent(TCL_DONT_WAIT); 2549 InvokeOSAActiveUPP(theComponent->defRefCon, theComponent->defActiveProc); 2550 2551 return noErr; 2552} 2553 2554/* 2555 *---------------------------------------------------------------------- 2556 * 2557 * ASCIICompareProc -- 2558 * 2559 * Trivial ascii compare for use with qsort. 2560 * 2561 * Results: 2562 * strcmp of the two input strings 2563 * 2564 * Side effects: 2565 * None 2566 * 2567 *---------------------------------------------------------------------- 2568 */ 2569static int 2570ASCIICompareProc(const void *first,const void *second) 2571{ 2572 int order; 2573 2574 char *firstString = *((char **) first); 2575 char *secondString = *((char **) second); 2576 2577 order = strcmp(firstString, secondString); 2578 2579 return order; 2580} 2581 2582#define REALLOC_INCR 30 2583/* 2584 *---------------------------------------------------------------------- 2585 * 2586 * getSortedHashKeys -- 2587 * 2588 * returns an alphabetically sorted list of the keys of the hash 2589 * theTable which match the string "pattern" in the DString 2590 * theResult. pattern == NULL matches all. 2591 * 2592 * Results: 2593 * None 2594 * 2595 * Side effects: 2596 * ReInitializes the DString theResult, then copies the names of 2597 * the matching keys into the string as list elements. 2598 * 2599 *---------------------------------------------------------------------- 2600 */ 2601 2602static void 2603getSortedHashKeys( 2604 Tcl_HashTable *theTable, 2605 CONST char *pattern, 2606 Tcl_DString *theResult) 2607{ 2608 Tcl_HashSearch search; 2609 Tcl_HashEntry *hPtr; 2610 Boolean compare = true; 2611 char *keyPtr; 2612 static char **resultArgv = NULL; 2613 static int totSize = 0; 2614 int totElem = 0, i; 2615 2616 if (pattern == NULL || *pattern == '\0' || 2617 (*pattern == '*' && *(pattern + 1) == '\0')) { 2618 compare = false; 2619 } 2620 2621 for (hPtr = Tcl_FirstHashEntry(theTable,&search), totElem = 0; 2622 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { 2623 2624 keyPtr = (char *) Tcl_GetHashKey(theTable, hPtr); 2625 if (!compare || Tcl_StringMatch(keyPtr, pattern)) { 2626 totElem++; 2627 if (totElem >= totSize) { 2628 totSize += REALLOC_INCR; 2629 resultArgv = (char **) ckrealloc((char *) resultArgv, 2630 totSize * sizeof(char *)); 2631 } 2632 resultArgv[totElem - 1] = keyPtr; 2633 } 2634 } 2635 2636 Tcl_DStringInit(theResult); 2637 if (totElem == 1) { 2638 Tcl_DStringAppendElement(theResult, resultArgv[0]); 2639 } else if (totElem > 1) { 2640 qsort((VOID *) resultArgv, (size_t) totElem, sizeof (char *), 2641 ASCIICompareProc); 2642 2643 for (i = 0; i < totElem; i++) { 2644 Tcl_DStringAppendElement(theResult, resultArgv[i]); 2645 } 2646 } 2647} 2648 2649/* 2650 *---------------------------------------------------------------------- 2651 * 2652 * prepareScriptData -- 2653 * 2654 * Massages the input data in the argv array, concating the 2655 * elements, with a " " between each, and replacing \n with \r, 2656 * and \\n with " ". Puts the result in the the DString scrptData, 2657 * and copies the result to the AEdesc scrptDesc. 2658 * 2659 * Results: 2660 * Standard Tcl result 2661 * 2662 * Side effects: 2663 * Creates a new Handle (with AECreateDesc) for the script data. 2664 * Stores the script in scrptData, or the error message if there 2665 * is an error creating the descriptor. 2666 * 2667 *---------------------------------------------------------------------- 2668 */ 2669 2670static int 2671prepareScriptData( 2672 int argc, 2673 CONST char **argv, 2674 Tcl_DString *scrptData, 2675 AEDesc *scrptDesc) 2676{ 2677 char * ptr; 2678 int i; 2679 char buffer[7]; 2680 OSErr sysErr = noErr; 2681 Tcl_DString encodedText; 2682 2683 Tcl_DStringInit(scrptData); 2684 2685 for (i = 0; i < argc; i++) { 2686 Tcl_DStringAppend(scrptData, argv[i], -1); 2687 Tcl_DStringAppend(scrptData, " ", 1); 2688 } 2689 2690 /* 2691 * First replace the \n's with \r's in the script argument 2692 * Also replace "\\n" with " ". 2693 */ 2694 2695 for (ptr = scrptData->string; *ptr != '\0'; ptr++) { 2696 if (*ptr == '\n') { 2697 *ptr = '\r'; 2698 } else if (*ptr == '\\') { 2699 if (*(ptr + 1) == '\n') { 2700 *ptr = ' '; 2701 *(ptr + 1) = ' '; 2702 } 2703 } 2704 } 2705 2706 Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(scrptData), 2707 Tcl_DStringLength(scrptData), &encodedText); 2708 sysErr = AECreateDesc(typeChar, Tcl_DStringValue(&encodedText), 2709 Tcl_DStringLength(&encodedText), scrptDesc); 2710 Tcl_DStringFree(&encodedText); 2711 2712 if (sysErr != noErr) { 2713 sprintf(buffer, "%6d", sysErr); 2714 Tcl_DStringFree(scrptData); 2715 Tcl_DStringAppend(scrptData, "Error #", 7); 2716 Tcl_DStringAppend(scrptData, buffer, -1); 2717 Tcl_DStringAppend(scrptData, " creating Script Data Descriptor.", 33); 2718 return TCL_ERROR; 2719 } 2720 2721 return TCL_OK; 2722} 2723 2724/* 2725 *---------------------------------------------------------------------- 2726 * 2727 * tclOSAResultFromID -- 2728 * 2729 * Gets a human readable version of the result from the script ID 2730 * and returns it in the result of the interpreter interp 2731 * 2732 * Results: 2733 * None 2734 * 2735 * Side effects: 2736 * Sets the result of interp to the human readable version of resultID. 2737 * 2738 * 2739 *---------------------------------------------------------------------- 2740 */ 2741 2742void 2743tclOSAResultFromID( 2744 Tcl_Interp *interp, 2745 ComponentInstance theComponent, 2746 OSAID resultID ) 2747{ 2748 OSErr myErr = noErr; 2749 AEDesc resultDesc; 2750 Tcl_DString resultStr; 2751 2752 Tcl_DStringInit(&resultStr); 2753 2754 myErr = OSADisplay(theComponent, resultID, typeChar, 2755 kOSAModeNull, &resultDesc); 2756 Tcl_DStringAppend(&resultStr, (char *) *resultDesc.dataHandle, 2757 GetHandleSize(resultDesc.dataHandle)); 2758 Tcl_DStringResult(interp,&resultStr); 2759} 2760 2761/* 2762 *---------------------------------------------------------------------- 2763 * 2764 * tclOSAASError -- 2765 * 2766 * Gets the error message from the AppleScript component, and adds 2767 * it to interp's result. If the script data is known, will point 2768 * out the offending bit of code. This MUST BE A NULL TERMINATED 2769 * C-STRING, not a typeChar. 2770 * 2771 * Results: 2772 * None 2773 * 2774 * Side effects: 2775 * Sets the result of interp to error, plus the relevant portion 2776 * of the script. 2777 * 2778 *---------------------------------------------------------------------- 2779 */ 2780 2781void 2782tclOSAASError( 2783 Tcl_Interp * interp, 2784 ComponentInstance theComponent, 2785 char *scriptData ) 2786{ 2787 OSErr myErr = noErr; 2788 AEDesc errResult,errLimits; 2789 Tcl_DString errStr; 2790 DescType returnType; 2791 Size returnSize; 2792 short srcStart,srcEnd; 2793 char buffer[16]; 2794 2795 Tcl_DStringInit(&errStr); 2796 Tcl_DStringAppend(&errStr, "An AppleScript error was encountered.\n", -1); 2797 2798 OSAScriptError(theComponent, kOSAErrorNumber, 2799 typeShortInteger, &errResult); 2800 2801// sprintf(buffer, "Error #%-6.6d\n", (short int) **errResult.dataHandle); 2802 sprintf(buffer, "Error #%-6.6d\n", (short int) **((char **)errResult.dataHandle)); 2803 2804 AEDisposeDesc(&errResult); 2805 2806 Tcl_DStringAppend(&errStr,buffer, 15); 2807 2808 OSAScriptError(theComponent, kOSAErrorMessage, typeChar, &errResult); 2809 Tcl_DStringAppend(&errStr, (char *) *errResult.dataHandle, 2810 GetHandleSize(errResult.dataHandle)); 2811 AEDisposeDesc(&errResult); 2812 2813 if (scriptData != NULL) { 2814 int lowerB, upperB; 2815 2816 myErr = OSAScriptError(theComponent, kOSAErrorRange, 2817 typeOSAErrorRange, &errResult); 2818 2819 myErr = AECoerceDesc(&errResult, typeAERecord, &errLimits); 2820 myErr = AEGetKeyPtr(&errLimits, keyOSASourceStart, 2821 typeShortInteger, &returnType, &srcStart, 2822 sizeof(short int), &returnSize); 2823 myErr = AEGetKeyPtr(&errLimits, keyOSASourceEnd, typeShortInteger, 2824 &returnType, &srcEnd, sizeof(short int), &returnSize); 2825 AEDisposeDesc(&errResult); 2826 AEDisposeDesc(&errLimits); 2827 2828 Tcl_DStringAppend(&errStr, "\nThe offending bit of code was:\n\t", -1); 2829 /* 2830 * Get the full line on which the error occured: 2831 */ 2832 for (lowerB = srcStart; lowerB > 0; lowerB--) { 2833 if (*(scriptData + lowerB ) == '\r') { 2834 lowerB++; 2835 break; 2836 } 2837 } 2838 2839 for (upperB = srcEnd; *(scriptData + upperB) != '\0'; upperB++) { 2840 if (*(scriptData + upperB) == '\r') { 2841 break; 2842 } 2843 } 2844 2845 Tcl_DStringAppend(&errStr, scriptData+lowerB, srcStart - lowerB); 2846 Tcl_DStringAppend(&errStr, "_", 1); 2847 Tcl_DStringAppend(&errStr, scriptData+srcStart, upperB - srcStart); 2848 } 2849 2850 Tcl_DStringResult(interp,&errStr); 2851} 2852 2853/* 2854 *---------------------------------------------------------------------- 2855 * 2856 * GetRawDataFromDescriptor -- 2857 * 2858 * Get the data from a descriptor. 2859 * 2860 * Results: 2861 * None 2862 * 2863 * Side effects: 2864 * None. 2865 * 2866 *---------------------------------------------------------------------- 2867 */ 2868 2869static void 2870GetRawDataFromDescriptor( 2871 AEDesc *theDesc, 2872 Ptr destPtr, 2873 Size destMaxSize, 2874 Size *actSize) 2875 { 2876 Size copySize; 2877 2878 if (theDesc->dataHandle) { 2879 HLock((Handle)theDesc->dataHandle); 2880 *actSize = GetHandleSize((Handle)theDesc->dataHandle); 2881 copySize = *actSize < destMaxSize ? *actSize : destMaxSize; 2882 BlockMove(*theDesc->dataHandle, destPtr, copySize); 2883 HUnlock((Handle)theDesc->dataHandle); 2884 } else { 2885 *actSize = 0; 2886 } 2887 2888 } 2889 2890/* 2891 *---------------------------------------------------------------------- 2892 * 2893 * GetRawDataFromDescriptor -- 2894 * 2895 * Get the data from a descriptor. Assume it's a C string. 2896 * 2897 * Results: 2898 * None 2899 * 2900 * Side effects: 2901 * None. 2902 * 2903 *---------------------------------------------------------------------- 2904 */ 2905 2906static OSErr 2907GetCStringFromDescriptor( 2908 AEDesc *sourceDesc, 2909 char *resultStr, 2910 Size resultMaxSize, 2911 Size *resultSize) 2912{ 2913 OSErr err; 2914 AEDesc resultDesc; 2915 2916 resultDesc.dataHandle = nil; 2917 2918 err = AECoerceDesc(sourceDesc, typeChar, &resultDesc); 2919 2920 if (!err) { 2921 GetRawDataFromDescriptor(&resultDesc, (Ptr) resultStr, 2922 resultMaxSize - 1, resultSize); 2923 resultStr[*resultSize] = 0; 2924 } else { 2925 err = errAECoercionFail; 2926 } 2927 2928 if (resultDesc.dataHandle) { 2929 AEDisposeDesc(&resultDesc); 2930 } 2931 2932 return err; 2933} 2934