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