mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2024-09-08 01:54:55 +00:00
Resource forks are included only for .rsrc files. These are DeRezzed into their data fork. 'ckid' resources, from the Projector VCS, are not included. The Tools directory, containing mostly junk, is also excluded.
2130 lines
89 KiB
OpenEdge ABL
2130 lines
89 KiB
OpenEdge ABL
{
|
|
File: AEDFWrapper.inc1.p
|
|
|
|
Written by: Ed Lai
|
|
|
|
Copyright: © 1990 by Apple Computer, Inc., all rights reserved.
|
|
|
|
This file is used in these builds: BigBang
|
|
|
|
Codes used in: BigBang,BigBang,BigBang,BigBang
|
|
Change History (most recent first):
|
|
|
|
<16> 2/5/91 Lai BM,#81596,81597: Also for bug jfr101 on whiteboard. For 81597,
|
|
hintIndex is now invalidated for regular and meta parameter
|
|
writes. For 81586, roundup is used in SetMsgAddr. In SetMsgAddr
|
|
and PutAttribute, GetDescInfo is used to obtain the correct
|
|
offset and size for list/reco.
|
|
<15> 1/18/91 Lai When adding a list/record to an attribute, skip the header.
|
|
<14> 1/11/91 Lai Fix bug of adding a null desc to AppleEvent and GetArray with
|
|
array type kAEDataArray
|
|
<13> 12/13/90 Lai Separation of the main files into separate modules
|
|
<12> 10/29/90 Lai Get around change in GetHandleSize glue
|
|
<11> 10/10/90 Lai MakeReturnID should take a parameter of LONGINT
|
|
<10> 9/21/90 Lai Fix bug that access mask and data available is only check when
|
|
doing GetPtr but not GetDesc.
|
|
<9> 9/20/90 Lai Do not allow adding a descriptor with key into an ordinary list
|
|
<8> 9/20/90 Lai When doing a Put N, return error if (N - number of items in
|
|
List) > 1
|
|
<7> 9/19/90 Lai Fix bug that in CreateMessage, extrabytes is not passed to
|
|
CreateBuffer
|
|
<6> 9/18/90 Lai transaction ID is now back as a meta parameter. More robust 'tid
|
|
' to 'sect' coercion.
|
|
<5> 9/15/90 ngk Fix for name changes in PPCToolbox.p
|
|
<4> 9/15/90 Lai Post code review clean-up, Coercion from tid to sect
|
|
<3+> 9/13/90 Lai Post code review clean-up
|
|
<3> 9/10/90 Lai Type case OSType to LONGINT for better compilation with 3.0
|
|
compiler.
|
|
<2> 9/7/90 Lai Fix comment
|
|
<1> 9/7/90 Lai first checked in
|
|
<0> 9/7/90 Lai First Checked in to BBS
|
|
---------------------
|
|
3-13 Mike Farr. I added wantAEDF to GlobalRec.
|
|
3-16 Mike Farr. Added clientsAddr to GlobalRec. Initialized in AEInit.
|
|
3-16 Eric House. Commented some code. Fixed bug in storing factored lists.
|
|
3-16 EKL CreateList, CreateMessage, CreateBuffer now return an OSErr, and
|
|
a var adddescparameter is used for the result
|
|
3-16 EKL AEPutPtr/AEPutDesc now returns an error when adding parameter to record/message
|
|
3-16 EKL Can now use AEPutPtr/AEPutDesc to record/message for replacing parameter
|
|
3-16 EKL AEInit has an additional procPtr for handling non-aevt high level event
|
|
3-19 EKL Now keep track of number of parameters in message
|
|
3-19 EKL Add AEListItemCount to return number of items in a list or a message
|
|
3-19 EKL Add AEQuit to terminate use of AEM
|
|
3-20 EKL Use Nick's Header file names
|
|
3-20 EKL Add counter for generating refcon
|
|
3-23 EKL In AEPutXXXX a nil ptr/handle is treated as 0 byte data rather than delete.
|
|
3-23 EKL Add AEDeteleXXXX to do the actual delete.
|
|
3-23 EKL CreateList is renamed to AECreateList and only create an empty list
|
|
3-23 EKL AEPutArray is used to write an array of data to a list
|
|
Currently if there is an error in middle of AEPutArray, it is possible to
|
|
have a partial addition, this will be improved in future.
|
|
3-23 EKL AEGetArray is for reading an array from a list.
|
|
3-26 EKL AERef is now a parameter in AEDisposeDesc
|
|
3-27 EKL AEInit now set AETable to nil
|
|
3-27 EKL Remove aMetaProto from Glboal, minimize the need to use global.
|
|
3-30 EKL Check if message end exactly at end of handle, otherwise it is error.
|
|
3-30 EKL Reclassify the error codes.
|
|
3-30 EKL Make AEDescCoercion public in stead of StdCoercion.
|
|
3-30 EKL In coercion, source = destination means change in place.
|
|
4-06 EJL In standard coercion, bug of not returning proper error fixed
|
|
|
|
To Do:
|
|
}
|
|
|
|
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]} { Pasmat format control line }
|
|
{ AEDFWrapper.inc1.p }
|
|
{ Copyright © 1984-1990 by Apple Computer Inc. All rights reserved. }
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
TYPE
|
|
|
|
{ this is the header with a transaction id as the meta parameter }
|
|
AEMetaTransaction = RECORD
|
|
aevtMarker: AEKeyWord;
|
|
version: LONGINT;
|
|
theKeyword: AEKeyWord;
|
|
theType: DescType;
|
|
theLength: LONGINT;
|
|
theValue: LONGINT;
|
|
metaTerminator: AEKeyWord;
|
|
END;
|
|
AEMetaTransPointer = ^AEMetaTransaction;
|
|
|
|
{ this record has the header info for an item in an AEList }
|
|
HeaderInfoRec = RECORD
|
|
aHeader: CommonHeader;
|
|
headSize: LONGINT;
|
|
prefixSize: LONGINT;
|
|
factorOut: LONGINT;
|
|
hasKey: BOOLEAN;
|
|
END;
|
|
|
|
{ this record is for extracting location of data in a AEDesc }
|
|
DescInfoRec = RECORD
|
|
dataType: DescType;
|
|
dataPtr: Ptr;
|
|
dataSize: LONGINT;
|
|
flag: SignedByte;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
FUNCTION IntMultiply(x, y: INTEGER): LONGINT; { result := x * y }
|
|
INLINE $301F, { move.w (a7)+,d0; pop y }
|
|
$C1DF, { muls.w (a7)+,d0; *x }
|
|
$2E80; { move.l do,(a7) ; put back result }
|
|
|
|
FUNCTION DivIFFShort(aShort: INTEGER;
|
|
aLong: LONGINT): INTEGER; { result := aLong DIV aShort, 0 if overflow
|
|
}
|
|
INLINE $201F, { move.l (a7)+,d0; aLong }
|
|
$81DF, { divs.w (a7)+,d0; aLong DIV aShort }
|
|
$6802, { bvc OK; no oveflow }
|
|
$4240, { clr.w, d0; 0 if overflow }
|
|
$3E80; { move.w d0, (a7); put back result }
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
FUNCTION AE_DeleteItem(VAR theAEDescList: AEDescList; { VAR is for efficiency only }
|
|
index: LONGINT): OSErr;
|
|
EXTERNAL;
|
|
|
|
FUNCTION AE_DeleteKeyDesc(VAR theAERecord: AERecord; { VAR is for efficiency only }
|
|
theAEKeyWord: AEKeyWord): OSErr;
|
|
EXTERNAL;
|
|
|
|
FUNCTION AE_GetNthDesc(VAR theAEDescList: AEDescList; { VAR is for efficiency only }
|
|
index: LONGINT;
|
|
desiredType: DescType;
|
|
VAR theAEKeyWord: AEKeyWord;
|
|
VAR theAEDesc: AEDesc): OSErr;
|
|
EXTERNAL;
|
|
|
|
FUNCTION AE_GetNthPtr(VAR theAEDescList: AEDescList;
|
|
index: LONGINT;
|
|
desiredType: DescType;
|
|
VAR theAEKeyWord: AEKeyWord;
|
|
VAR typeCode: DescType;
|
|
dataPtr: Ptr;
|
|
maximumSize: LONGINT;
|
|
VAR actualSize: LONGINT): OSErr;
|
|
EXTERNAL;
|
|
|
|
FUNCTION AE_PutKeyPtr(VAR theAERecord: AERecord; { VAR is for efficiency only }
|
|
theAEKeyWord: AEKeyWord;
|
|
typeCode: DescType;
|
|
dataPtr: Ptr;
|
|
dataSize: LONGINT): OSErr;
|
|
EXTERNAL;
|
|
|
|
FUNCTION AE_PutDesc(VAR theAEDescList: AEDescList; { VAR is for efficiency only }
|
|
index: LONGINT;
|
|
VAR theAEDesc: AEDesc { VAR is for efficiency only }
|
|
): OSErr;
|
|
EXTERNAL;
|
|
|
|
FUNCTION AE_PutPtr(VAR theAEDescList: AEDescList; { VAR is for efficiency only }
|
|
index: LONGINT;
|
|
typeCode: DescType;
|
|
dataPtr: Ptr;
|
|
dataSize: LONGINT): OSErr;
|
|
EXTERNAL;
|
|
|
|
FUNCTION AE_PutKeyDesc(VAR theAERecord: AERecord; { VAR is for efficiency only }
|
|
theAEKeyWord: AEKeyWord;
|
|
VAR theAEDesc: AEDesc { VAR is for efficiency only }
|
|
): OSErr;
|
|
EXTERNAL;
|
|
|
|
FUNCTION AE_GetAttributePtr(VAR theAppleEvent: AppleEvent; { VAR is for efficiency only }
|
|
theAEKeyWord: AEKeyWord;
|
|
desiredType: DescType;
|
|
VAR typeCode: DescType;
|
|
dataPtr: Ptr;
|
|
maximumSize: Size;
|
|
VAR actualSize: Size): OSErr;
|
|
EXTERNAL;
|
|
|
|
FUNCTION AE_GetAttributeDesc(VAR theAppleEvent: AppleEvent; { VAR is for efficiency only }
|
|
theAEKeyWord: AEKeyWord;
|
|
desiredType: DescType;
|
|
VAR result: AEDesc): OSErr;
|
|
EXTERNAL;
|
|
|
|
FUNCTION AE_SizeOfAttribute(VAR theAppleEvent: AppleEvent; { VAR is for efficiency only }
|
|
theAEKeyWord: AEKeyWord;
|
|
VAR typeCode: DescType;
|
|
VAR dataSize: Size): OSErr;
|
|
EXTERNAL;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
FUNCTION CheckDesc(VAR theAEDescList: AEDescList;
|
|
VAR theDescClass: DescClass;
|
|
waitReady: BOOLEAN): OSErr;
|
|
FORWARD;
|
|
|
|
FUNCTION ExtractDescriptor(msg: MsgHdrHdl;
|
|
dataType: DescType;
|
|
dataSize, dataOffset, factorOut: LONGINT;
|
|
VAR res: AEDesc): OSErr;
|
|
FORWARD;
|
|
|
|
PROCEDURE FindDescOffset(msgClass: DescClass;
|
|
msg: MsgHdrHdl;
|
|
VAR index: LONGINT;
|
|
VAR key: AEKeyWord;
|
|
VAR offset: LONGINT;
|
|
VAR aHeaderInfoRec: HeaderInfoRec);
|
|
FORWARD;
|
|
|
|
PROCEDURE GetAttributeOffset(key: AEKeyWord;
|
|
VAR offset: LONGINT;
|
|
VAR dataType: DescType);
|
|
FORWARD;
|
|
|
|
FUNCTION GetDescInfo(VAR theAEDesc: AEDesc; { VAR is for efficiency only }
|
|
VAR descInfo: DescInfoRec): OSErr;
|
|
FORWARD;
|
|
|
|
FUNCTION MakeReturnID(ReturnID: LONGINT): LONGINT;
|
|
FORWARD;
|
|
|
|
PROCEDURE SetAccessMask(msg: MsgHdrHdl;
|
|
index: LONGINT);
|
|
FORWARD;
|
|
|
|
FUNCTION SetMsgAddress(theMsgHdrHdl: MsgHdrHdl;
|
|
typeCode: DescType;
|
|
dataPtr: Ptr;
|
|
dataSize: LONGINT): OSErr;
|
|
FORWARD;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ This is the basic routine to add a desc to a list, it essentially calls write data
|
|
but takes special caution in the case where theArg is a list/record, an
|
|
AppleEvent or is nil }
|
|
|
|
FUNCTION AddDesc(VAR theAEDescList: AEDescList; { VAR is for efficiency only }
|
|
key: AEKeyWord;
|
|
VAR theArg: AEDesc; { VAR is for efficiency only }
|
|
index: LONGINT): OSErr;
|
|
|
|
VAR
|
|
err: OSErr;
|
|
descInfo: DescInfoRec;
|
|
|
|
BEGIN
|
|
err := GetDescInfo(theArg, descInfo); { get the location }
|
|
IF err = noErr THEN
|
|
WITH descInfo DO
|
|
BEGIN
|
|
err := WriteData(theAEDescList, key, dataType, dataPtr, dataSize, index, 1);
|
|
HSetState(theArg.dataHandle, flag);
|
|
END;
|
|
AddDesc := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ count number of items, just get it from the header }
|
|
|
|
FUNCTION AE_CountItems(VAR theAEDescList: AEDescList; { VAR is for efficiency only }
|
|
VAR theCount: LONGINT): OSErr;
|
|
|
|
VAR
|
|
msgClass: DescClass;
|
|
err: OSErr;
|
|
|
|
BEGIN
|
|
theCount := 0;
|
|
err := CheckDesc(theAEDescList, msgClass, TRUE);
|
|
IF err = NoErr THEN
|
|
WITH MsgHdrHdl(theAEDescList.dataHandle)^^ DO
|
|
BEGIN
|
|
IF msgClass = classMeta THEN
|
|
theCount := listClassHeader.metaCountOrObjType
|
|
ELSE { note that this works because paramCount is
|
|
at the same position }
|
|
theCount := paramCount;
|
|
END;
|
|
AE_CountItems := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ create an AppleEvent message, createBare message set up the buffer, then we
|
|
set the address and finish initialization by calling CheckMessage }
|
|
|
|
FUNCTION AE_CreateAppleEvent(theAEEventClass: AEEventClass;
|
|
theAEEventID: AEEventID;
|
|
VAR target: AEAddressDesc; { VAR is for efficiency only }
|
|
ReturnID: INTEGER;
|
|
transactionID: LONGINT;
|
|
VAR result: AppleEvent): OSErr;
|
|
|
|
VAR
|
|
err: OSErr;
|
|
descInfo: DescInfoRec;
|
|
|
|
BEGIN
|
|
err := GetDescInfo(target, descInfo);{ get the location }
|
|
IF err = noErr THEN
|
|
WITH descInfo DO
|
|
BEGIN
|
|
err := CreateBareMessage(dataSize, theAEEventClass, theAEEventID, ReturnID, transactionID,
|
|
result);
|
|
IF err = NoErr THEN
|
|
BEGIN
|
|
err := SetMsgAddress(MsgHdrHdl(result.dataHandle), dataType, dataPtr, dataSize);
|
|
IF err <> NoErr THEN
|
|
DisposHandle(result.dataHandle)
|
|
ELSE
|
|
BEGIN
|
|
{ use CheckMessage to finish the initialization }
|
|
IgnoreOSErr(CheckMessage(MsgHdrHdl(result.dataHandle))); { would not return error }
|
|
END;
|
|
END;
|
|
HSetState(target.dataHandle, flag);
|
|
END;
|
|
IF err <> NoErr THEN
|
|
NukeIt(result);
|
|
AE_CreateAppleEvent := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ release a desc, we have to watch out for the special case where it is an AppleEvent
|
|
in which case we make sure it is not also be used by the client/server (then
|
|
the status will be that it is used by one party instead of both), we should
|
|
also free up the access mask handle if there is one }
|
|
|
|
FUNCTION AE_DisposeDesc(VAR theAEDesc: AEDesc): OSErr;
|
|
|
|
VAR
|
|
canDispose: BOOLEAN;
|
|
err: OSErr;
|
|
|
|
BEGIN
|
|
err := NoErr;
|
|
WITH theAEDesc DO
|
|
BEGIN
|
|
IF dataHandle <> NIL THEN
|
|
BEGIN
|
|
canDispose := TRUE;
|
|
IF LONGINT(descriptorType) = LONGINT(kCoreEventClass) THEN
|
|
WITH MsgHdrHdl(dataHandle)^^ DO
|
|
BEGIN
|
|
IF inUse THEN
|
|
BEGIN
|
|
{ we cannot dispose it because it is held by both parties }
|
|
canDispose := FALSE;
|
|
{ but dispose by one party means it will no longer be held by both parties }
|
|
inUse := FALSE;
|
|
END
|
|
ELSE IF paramCount > 32 THEN
|
|
DisposHandle(Handle(accessMask)); { accessMask is really a handle }
|
|
IF inWaiting THEN { we better take it off the waiting list }
|
|
OffWaitList(MsgHdrHdl(dataHandle));
|
|
END;
|
|
IF canDispose THEN
|
|
BEGIN
|
|
DisposHandle(dataHandle);
|
|
dataHandle := NIL; { we nil it for safety }
|
|
END;
|
|
IF dataHandle = NIL THEN
|
|
descriptorType := typeNull;
|
|
END;
|
|
END;
|
|
AE_DisposeDesc := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ read a whole list of descriptors }
|
|
|
|
FUNCTION AE_GetArray(VAR theAEDescList: AEDescList; { VAR is for efficiency only }
|
|
arrayType: AEArrayType;
|
|
arrayPtr: AEArrayDataPointer;
|
|
maximumSize: LONGINT;
|
|
VAR itemType: DescType;
|
|
VAR itemSize: LONGINT;
|
|
VAR itemCount: LONGINT): OSErr;
|
|
{ not yet optimized }
|
|
|
|
LABEL 999;
|
|
|
|
VAR
|
|
dataEnd: LONGINT;
|
|
aDesc: AEDesc;
|
|
aHeaderInfoRec: HeaderInfoRec;
|
|
done: BOOLEAN;
|
|
err: OSErr;
|
|
itemLength: LONGINT;
|
|
listSize: LONGINT;
|
|
dummySize: LONGINT;
|
|
dummyType: DescType;
|
|
dummyKey: AEKeyWord;
|
|
msgClass: DescClass;
|
|
|
|
{ errAEWrongDataType means that you cannot get kAEDataArray, kAEHandleArray out of a list
|
|
where items can be of variable size }
|
|
|
|
BEGIN
|
|
err := CheckDesc(theAEDescList, msgClass, FALSE); { no need to check for reply ready here }
|
|
IF err <> NoErr THEN
|
|
GOTO 999;
|
|
IgnoreOSErr(AE_CountItems(theAEDescList, listSize));
|
|
itemCount := 0;
|
|
done := FALSE;
|
|
{ find header info by calling FindDescOffset with an illegal Index }
|
|
dummySize := - 1;
|
|
FindDescOffset(msgClass, MsgHdrHdl(theAEDescList.dataHandle), dummySize, dummyKey,
|
|
dataEnd {dummy} , aHeaderInfoRec);
|
|
WITH aHeaderInfoRec DO
|
|
BEGIN
|
|
IF prefixSize < 4 THEN
|
|
itemType := typeWildCard { it is not a homogenous list }
|
|
ELSE
|
|
itemType := aHeader.theType; { it is a homogenous list }
|
|
IF prefixSize < 8 THEN
|
|
itemSize := - 1 { size is variable }
|
|
ELSE
|
|
itemSize := aHeader.theLength; { size is fixed }
|
|
IF (ord(arrayType) <= ord(kAEPackedArray)) THEN { a shorter way of saying kAEDataArray or
|
|
KAEPackeArray }
|
|
BEGIN
|
|
{ read data array, if header is factored out we read in a single operation,
|
|
otherwise we do it one by oen }
|
|
WITH aHeader DO
|
|
BEGIN
|
|
IF (prefixSize < 8) THEN
|
|
BEGIN
|
|
err := errAEWrongDataType;
|
|
GOTO 999;
|
|
END;
|
|
itemLength := theLength;
|
|
IF itemLength <= 0 THEN
|
|
GOTO 999; { there is no data, so nothing is read }
|
|
IF arrayType = kAEdataArray THEN
|
|
itemLength := BAnd(itemLength + RoundUpValue, roundUpMask);
|
|
IF (factorOut = 0) THEN { if no factoring }
|
|
IF NOT hasKey THEN { if no key then data is contiguous }
|
|
IF ((itemSize = 1) = (arrayType = kAEPackedArray)) OR (NOT BTst(itemSize,
|
|
0)) THEN
|
|
IF (itemLength < MAXINT) THEN { if does not require long division }
|
|
BEGIN { see we can do it in one operation? }
|
|
itemCount := DivIFFShort(maximumSize, itemLength);
|
|
IF itemCount > 0 THEN { we can do it in one operation }
|
|
BEGIN
|
|
IF itemCount > listSize THEN
|
|
itemCount := listSize; { only so many is in there }
|
|
WITH ListHdrHdl(theAEDescList.dataHandle)^^ DO
|
|
BlockMove(Ptr(ord(theAEDescList.dataHandle^) +
|
|
listClassHeader.paramBegin), Ptr(arrayPtr),
|
|
IntMultiply(itemCount, itemLength));
|
|
done := TRUE;
|
|
END;
|
|
END;
|
|
END;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
itemLength := BSL(ord(arrayType) - ord(kAEPackedArray), 2); { 4, 8, 12 for the three
|
|
types }
|
|
IF arrayType = kAEHandleArray THEN
|
|
BEGIN
|
|
IF (prefixSize < 4) THEN
|
|
BEGIN
|
|
err := errAEWrongDataType;
|
|
GOTO 999;
|
|
END;
|
|
aDesc.descriptorType := aHeader.theType;
|
|
END;
|
|
END;
|
|
END;
|
|
|
|
IF NOT done THEN
|
|
BEGIN
|
|
dataEnd := ord(arrayPtr) + maximumSize - itemLength;
|
|
WHILE (ord(arrayPtr) <= dataEnd) AND (itemCount < listSize) DO
|
|
BEGIN
|
|
IF (ord(arrayType) <= ord(kAEPackedArray)) THEN { a shorter way of saying kAEDataArray
|
|
or KAEPackeArray }
|
|
err := ReadData(theAEDescList, itemCount + 1, typeWildCard, dummyKey, dummyType,
|
|
Ptr(arrayPtr), itemSize, dummySize)
|
|
ELSE
|
|
err := AE_GetNthDesc(theAEDescList, itemCount + 1, typeWildCard, dummyKey, aDesc);
|
|
IF err <> NoErr THEN
|
|
GOTO 999;
|
|
itemCount := itemCount + 1;
|
|
CASE arrayType OF
|
|
kAEHandleArray:
|
|
BEGIN
|
|
LONGINTPtr(arrayPtr)^ := LONGINT(aDesc.dataHandle);
|
|
END;
|
|
kAEDescArray:
|
|
BEGIN
|
|
AEDescPtr(arrayPtr)^ := aDesc;
|
|
END;
|
|
kAEKeyDescArray:
|
|
WITH AEKeyDescPtr(arrayPtr)^ DO
|
|
BEGIN
|
|
descKey := dummyKey;
|
|
descContent := aDesc;
|
|
END;
|
|
END;
|
|
arrayPtr := AEArrayDataPointer(ord(arrayPtr) + itemLength);
|
|
END;
|
|
END;
|
|
999:
|
|
AE_GetArray := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ it is more difficult to use the assembler trick here because theAEKeyWord Parameter
|
|
in FetchDesc is a VAR }
|
|
|
|
FUNCTION AE_GetKeyDesc(VAR theAERecord: AERecord; { VAR is for efficiency only }
|
|
theAEKeyWord: AEKeyWord;
|
|
desiredType: DescType;
|
|
VAR result: AEDesc): OSErr;
|
|
|
|
BEGIN
|
|
AE_GetKeyDesc := FetchDesc(theAERecord, 0, desiredType, theAEKeyWord, result);
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
FUNCTION AE_GetKeyPtr(VAR theAERecord: AERecord; { VAR is for efficiency only }
|
|
theAEKeyWord: AEKeyWord;
|
|
desiredType: DescType;
|
|
VAR typeCode: DescType;
|
|
dataPtr: Ptr;
|
|
maximumSize: Size;
|
|
VAR actualSize: Size): OSErr;
|
|
|
|
BEGIN
|
|
AE_GetKeyPtr := ReadData(theAERecord, 0, desiredType, theAEKeyWord, typeCode, dataPtr,
|
|
maximumSize, actualSize);
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
FUNCTION AE_PutArray(VAR theAEDescList: AEDescList; { VAR is for efficiency only }
|
|
arrayType: AEArrayType;
|
|
arrayPtr: AEArrayDataPointer;
|
|
itemType: DescType;
|
|
itemSize: Size;
|
|
itemCount: LONGINT): OSErr;
|
|
{ not yet optimized }
|
|
|
|
VAR
|
|
msgClass: DescClass;
|
|
i: LONGINT;
|
|
dummy: LONGINT;
|
|
aDesc: AEDesc;
|
|
err: OSErr;
|
|
aHeaderInfoRec: HeaderInfoRec;
|
|
uniform: BOOLEAN;
|
|
done: BOOLEAN;
|
|
|
|
LABEL 999;
|
|
|
|
BEGIN
|
|
done := FALSE;
|
|
err := CheckDesc(theAEDescList, msgClass, FALSE);
|
|
IF err <> NoErr THEN
|
|
GOTO 999;
|
|
{ find header info by calling FindDescOffset with an illegal Index }
|
|
i := - 1;
|
|
FindDescOffset(msgClass, MsgHdrHdl(theAEDescList.dataHandle), i, AEKeyWord(dummy), dummy,
|
|
aHeaderInfoRec);
|
|
|
|
WITH aHeaderInfoRec DO
|
|
BEGIN
|
|
IF hasKey THEN
|
|
IF (arrayType <> kAEKeyDescArray) THEN
|
|
BEGIN
|
|
err := errAEWrongDataType;
|
|
GOTO 999;
|
|
END;
|
|
IF (ord(arrayType) <= ord(kAEPackedArray)) THEN { a shorter way of saying kAEDataArray or
|
|
KAEPackeArray }
|
|
BEGIN
|
|
{ if it is uniform and factored, we may do it in one operation, otherewise
|
|
we do it one by one }
|
|
WITH aHeader DO
|
|
BEGIN
|
|
uniform := FALSE;
|
|
IF prefixSize < 4 THEN
|
|
theType := itemType;
|
|
IF prefixSize < 8 THEN
|
|
theLength := itemSize
|
|
ELSE
|
|
uniform := TRUE;
|
|
IF (LONGINT(theType) <> LONGINT(itemType)) OR (theLength <> itemSize) THEN
|
|
BEGIN
|
|
err := errAEWrongDataType;
|
|
GOTO 999;
|
|
END;
|
|
IF arrayType = kAEdataArray THEN
|
|
theLength := BAnd(theLength + RoundUpValue, roundUpMask);
|
|
IF uniform THEN { data is contiguous because type and size
|
|
is factored and there is no key }
|
|
IF (factorOut = 0) THEN { if no factoring }
|
|
IF ((itemSize = 1) = (arrayType = kAEPackedArray)) OR (NOT BTst(itemSize,
|
|
0)) THEN { data array is some layout as internal }
|
|
BEGIN { we can do it in one operation }
|
|
err := PtrAndHand(Ptr(arrayPtr), theAEDescList.dataHandle, itemCount *
|
|
theLength);
|
|
IF err <> NoErr THEN
|
|
GOTO 999;
|
|
WITH ListHdrHdl(theAEDescList.dataHandle)^^ DO
|
|
paramCount := paramCount + itemCount;
|
|
done := TRUE;
|
|
END;
|
|
END;
|
|
END;
|
|
IF NOT done THEN
|
|
BEGIN
|
|
IF arrayType = kAEHandleArray THEN
|
|
BEGIN
|
|
IF prefixSize >= 4 THEN
|
|
IF (LONGINT(aHeader.theType) <> LONGINT(itemType)) THEN
|
|
BEGIN
|
|
err := errAEWrongDataType;
|
|
GOTO 999;
|
|
END;
|
|
aDesc.descriptorType := itemType;
|
|
END;
|
|
FOR i := itemCount DOWNTO 1 DO
|
|
BEGIN
|
|
CASE arrayType OF
|
|
kAEHandleArray:
|
|
BEGIN
|
|
aDesc.dataHandle := HandlePtr(arrayPtr)^;
|
|
err := AE_PutDesc(theAEDescList, 0, aDesc);
|
|
arrayPtr := AEArrayDataPointer(ord(arrayPtr) + SizeOf(Handle));
|
|
END; { end kAEHandleArray }
|
|
kAEDescArray:
|
|
BEGIN
|
|
err := AE_PutDesc(theAEDescList, 0, AEDescPtr(arrayPtr)^);
|
|
arrayPtr := AEArrayDataPointer(ord(arrayPtr) + SizeOf(AEDesc));
|
|
END; { end kAEDescArray }
|
|
kAEKeyDescArray:
|
|
BEGIN
|
|
WITH AEKeyDescPtr(arrayPtr)^ DO
|
|
err := AE_PutKeyDesc(theAEDescList, descKey, descContent);
|
|
arrayPtr := AEArrayDataPointer(ord(arrayPtr) + SizeOf(AEKeyDesc));
|
|
END; { end kAEkeyDescArray }
|
|
OTHERWISE
|
|
BEGIN
|
|
err := AE_PutPtr(theAEDescList, 0, itemType, Ptr(arrayPtr), itemSize);
|
|
arrayPtr := AEArrayDataPointer(ord(arrayPtr) + aHeader.theLength);
|
|
END;
|
|
END; { case }
|
|
IF err <> NoErr THEN
|
|
GOTO 999;
|
|
END;
|
|
END;
|
|
END;
|
|
999:
|
|
AE_PutArray := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ to set an attribute }
|
|
{ just lock it and call PutPtrAttribute }
|
|
|
|
FUNCTION AE_PutAttributeDesc(VAR theAppleEvent: AEDescList; { VAR is for efficiency only }
|
|
theAEKeyWord: AEKeyWord;
|
|
VAR theAEDesc: AEDesc { VAR is for efficiency only }
|
|
): OSErr;
|
|
|
|
VAR
|
|
err: OSErr;
|
|
descInfo: DescInfoRec;
|
|
|
|
BEGIN
|
|
err := GetDescInfo(theAEDesc, descInfo);{ get the location }
|
|
IF err = noErr THEN
|
|
WITH descInfo DO
|
|
BEGIN
|
|
err := AE_PutAttributePtr(theAppleEvent, theAEKeyWord, dataType, dataPtr, dataSize);
|
|
HSetState(theAEDesc.dataHandle, flag);
|
|
END;
|
|
AE_PutAttributeDesc := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ to add an attribute pointed to by a pointer }
|
|
{ if it is a pseudo meta parameter, we determine its offset and size and put it
|
|
there, otherwise do it like a meta parameter }
|
|
|
|
FUNCTION AE_PutAttributePtr(VAR theAppleEvent: AEDescList; { VAR is for efficiency only }
|
|
theAEKeyWord: AEKeyWord;
|
|
typeCode: DescType;
|
|
dataPtr: Ptr;
|
|
dataSize: LONGINT): OSErr;
|
|
|
|
VAR
|
|
err: OSErr;
|
|
offset: LONGINT;
|
|
result: AEDesc;
|
|
expectSize: LONGINT;
|
|
expectType: DescType;
|
|
disp: LONGINT;
|
|
|
|
BEGIN
|
|
err := errAENotAEDesc;
|
|
IF (LONGINT(theAppleEvent.descriptorType) = LONGINT(kCoreEventClass)) AND
|
|
(theAppleEvent.dataHandle <> NIL) THEN
|
|
BEGIN
|
|
err := NoErr;
|
|
result.dataHandle := NIL;
|
|
{ for those at fixed position and fix size, we determine the position first }
|
|
expectSize := 4; { most common used value, use as default }
|
|
GetAttributeOffset(theAEKeyWord, offset, expectType);
|
|
IF offset > 0 THEN
|
|
BEGIN
|
|
{ these are the fixed postion fixed size cases }
|
|
{ for these, we must have it in the correct type }
|
|
IF expectType <> typeCode THEN
|
|
err := AE_CoercePtr(typeCode, dataPtr, dataSize, expectType, result);
|
|
IF err = NoErr THEN
|
|
BEGIN
|
|
IF result.dataHandle <> NIL THEN
|
|
BEGIN
|
|
dataPtr := result.dataHandle^;
|
|
dataSize := GetHandleSize(result.dataHandle);
|
|
END;
|
|
{ the size must be right or we cannot do it }
|
|
IF expectSize = dataSize THEN
|
|
BEGIN
|
|
{ we just move it in }
|
|
BlockMove(dataPtr, Ptr(ord(theAppleEvent.dataHandle^) + offset), expectSize);
|
|
{ for return ID, we need to consider case of autogeneartion of ID }
|
|
IF theAEKeyWord = keyReturnIDAttr THEN
|
|
WITH MsgHdrHdl(theAppleEvent.dataHandle)^^ DO
|
|
IF ReturnID = kAutoGenerateReturnID THEN
|
|
ReturnID := MakeReturnID(kAutoGenerateReturnID);
|
|
END
|
|
ELSE
|
|
err := errAECoercionFail;
|
|
DisposHandle(result.dataHandle);
|
|
END;
|
|
END
|
|
ELSE IF LONGINT(theAEKeyWord) = LONGINT(keyAddressAttr) THEN
|
|
{ special case for address because it is variable size }
|
|
err := SetMsgAddress(MsgHdrHdl(theAppleEvent.dataHandle), typeCode, dataPtr, dataSize)
|
|
ELSE
|
|
BEGIN { otherwise it is just a meta parameter }
|
|
err := WriteData(MakeMeta(theAppleEvent), theAEKeyWord, typeCode, dataPtr, dataSize, 0,
|
|
1);
|
|
END;
|
|
END;
|
|
AE_PutAttributePtr := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ get size of descriptor , just pass NIL to Ptr in ReadData }
|
|
|
|
FUNCTION AE_SizeOfKeyDesc(VAR theAERecord: AERecord; { VAR is for efficiency only }
|
|
theAEKeyWord: AEKeyWord;
|
|
VAR typeCode: DescType;
|
|
VAR dataSize: LONGINT): OSErr;
|
|
|
|
BEGIN
|
|
AE_SizeOfKeyDesc := ReadData(theAERecord, 0, typeWildCard, theAEKeyWord, typeCode, NIL, 0,
|
|
dataSize);
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ get size of descriptor , just pass NIL to Ptr in ReadData }
|
|
|
|
FUNCTION AE_SizeOfNthItem(VAR theAEDescList: AEDescList; { VAR is for efficiency only }
|
|
index: LONGINT;
|
|
VAR typeCode: DescType;
|
|
VAR dataSize: LONGINT): OSErr;
|
|
|
|
VAR
|
|
dummyKey: AEKeyWord;
|
|
|
|
BEGIN
|
|
AE_SizeOfNthItem := ReadData(theAEDescList, index, typeWildCard, dummyKey, typeCode, NIL, 0,
|
|
dataSize);
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ check the message to see if it is an AppleEvent, and initialized its header }
|
|
|
|
FUNCTION CheckMessage(msg: MsgHdrHdl): OSErr;
|
|
|
|
LABEL 998, 999;
|
|
|
|
VAR
|
|
err: OSErr;
|
|
aMetaPtr: AEMetaPointer;
|
|
aCommonPtr: CommonHeaderPointer;
|
|
dataEnd: LONGINT;
|
|
count: LONGINT;
|
|
|
|
BEGIN
|
|
WITH msg^^ DO
|
|
BEGIN
|
|
listClassHeader.hintIndex := 0;
|
|
aMetaPtr := AEMetaPointer(ord(Handle(msg)^) + BAnd(SizeOf(MsgHdr) - SizeOf(TargetID) +
|
|
msg^^.msgAddrSize + RoundUpValue, RoundUpMask));
|
|
END;
|
|
WITH aMetaPtr^ DO
|
|
BEGIN
|
|
IF (LONGINT(aevtMarker) <> LONGINT(kCoreEventClass)) THEN
|
|
BEGIN
|
|
err := errAENotAppleEvent;
|
|
GOTO 999;
|
|
END
|
|
ELSE IF (version <> kVersionOne) THEN
|
|
BEGIN
|
|
err := errAENewerVersion;
|
|
GOTO 999;
|
|
END;
|
|
END;
|
|
dataEnd := ord(Handle(msg)^) + GetHandleSize(Handle(msg));
|
|
aCommonPtr := CommonHeaderPointer(ord(aMetaPtr) + 8);
|
|
{ count the number of meta parameters }
|
|
count := 0;
|
|
WHILE (ord(aCommonPtr) < dataEnd) AND (LONGINT(aCommonPtr^.theKeyword) <>
|
|
LONGINT(aeEndOfMetaDataKeyword)) DO
|
|
BEGIN
|
|
count := count + 1;
|
|
IF aCommonPtr^.theLength < 0 THEN
|
|
GOTO 998;
|
|
{ aCommonPtr := CommonHeaderPointer(ord(aCommonPtr) + RoundUp(aCommonPtr^.theLength +
|
|
SizeOf(CommonHeader))); }
|
|
aCommonPtr := CommonHeaderPointer(ord(aCommonPtr) + BAnd(aCommonPtr^.theLength +
|
|
SizeOf(CommonHeader) +
|
|
RoundUpValue, roundUpMask));
|
|
END;
|
|
IF (ord(aCommonPtr) < dataEnd) AND (LONGINT(aCommonPtr^.theKeyword) =
|
|
LONGINT(aeEndOfMetaDataKeyword)) THEN
|
|
WITH msg^^ DO
|
|
BEGIN
|
|
WITH listClassHeader DO
|
|
BEGIN
|
|
paramBegin := ord(aCommonPtr) - ord(Handle(msg)^) + 4;
|
|
metaCountOrObjType := count;
|
|
END;
|
|
aCommonPtr := CommonHeaderPointer(ord(aCommonPtr) + 4); { skip meta terminator }
|
|
{ count the number of parameters }
|
|
count := 0;
|
|
WHILE (ord(aCommonPtr) < dataEnd) DO
|
|
BEGIN
|
|
count := count + 1;
|
|
IF aCommonPtr^.theLength < 0 THEN
|
|
GOTO 998;
|
|
aCommonPtr := CommonHeaderPointer(ord(aCommonPtr) + BAnd(aCommonPtr^.theLength +
|
|
SizeOf(CommonHeader) +
|
|
RoundUpValue,
|
|
roundUpMask));
|
|
END;
|
|
{ the message must end when the parameters ends }
|
|
IF (ord(aCommonPtr) <> dataEnd) THEN
|
|
GOTO 998; { descriptor ending must match data end
|
|
exactly }
|
|
paramCount := count;
|
|
inWaiting := FALSE;
|
|
CheckMessage := NoErr;
|
|
END
|
|
ELSE
|
|
GOTO 998;
|
|
err := NoErr;
|
|
GOTO 999;
|
|
998:
|
|
err := errAECorruptData;
|
|
999:
|
|
CheckMessage := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ create an empty message with no parameter, but header is not yet initialized }
|
|
|
|
FUNCTION CreateBareMessage(msgAddrLen: LONGINT;
|
|
theAEEventClass: AEEventClass;
|
|
theAEEventID: AEEventID;
|
|
theReturnID: LONGINT;
|
|
theTransactionID: LONGINT;
|
|
VAR result: AppleEvent): OSErr;
|
|
|
|
VAR
|
|
err: OSErr;
|
|
anAEMetaPointer: AEMetaPointer;
|
|
extraBytes: LONGINT;
|
|
|
|
BEGIN
|
|
{ transaction ID is a meta parameter, but we don't put it up if it is zero }
|
|
IF theTransactionID = kAnyTransactionID THEN
|
|
extraBytes := 0
|
|
ELSE
|
|
extraBytes := SizeOf(AEMetaTransaction) - SizeOf(AEMetaDesc);
|
|
err := CreateBuffer(extraBytes, msgAddrLen, theAEEventClass, theAEEventID, result);
|
|
IF err = NoErr THEN
|
|
BEGIN
|
|
WITH MsgHdrHdl(result.dataHandle)^^ DO
|
|
ReturnID := MakeReturnID(theReturnID);
|
|
anAEMetaPointer := AEMetaPointer(ord(result.dataHandle^) + BAnd(SizeOf(MsgHdr) -
|
|
SizeOf(TargetID) + msgAddrLen + RoundUpValue, RoundUpMask));
|
|
WITH anAEMetaPointer^ DO
|
|
BEGIN
|
|
aevtMarker := kCoreEventClass;
|
|
version := kVersionOne;
|
|
metaTerminator := aeEndOfMetaDataKeyword;
|
|
END;
|
|
{ if we have nonzero transaction ID, we put it up as parameter }
|
|
IF theTransactionID <> kAnyTransactionID THEN
|
|
WITH AEMetaTransPointer(anAEMetaPointer)^ DO
|
|
BEGIN
|
|
theKeyword := keyTransactionIDAttr;
|
|
theType := typeLongInteger;
|
|
theLength := SizeOf(theValue);
|
|
theValue := theTransactionID;
|
|
metaTerminator := aeEndOfMetaDataKeyword;
|
|
END;
|
|
END;
|
|
CreateBareMessage := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ create a message buffer }
|
|
{ this can be used to generate an empty message, or it can be used as the buffer
|
|
for reading in a message }
|
|
|
|
FUNCTION CreateBuffer(extraBytes: LONGINT;
|
|
msgAddrLen: LONGINT;
|
|
theAEEventClass: AEEventClass;
|
|
theAEEventID: AEEventID;
|
|
VAR result: AppleEvent): OSErr;
|
|
|
|
VAR
|
|
aHandle: Handle;
|
|
anAEMetaPointer: AEMetaPointer;
|
|
|
|
BEGIN
|
|
{ extra bytes is the number of extra bytes needed in the handle }
|
|
{ no extra byte means AEAddress has no length }
|
|
aHandle := NewHandle(SizeOf(AEMetaDesc) + SizeOf(MsgHdr) - SizeOf(TargetID) +
|
|
extraBytes + BAnd(msgAddrLen + RoundUpValue, RoundUpMask));
|
|
WITH result DO
|
|
BEGIN
|
|
descriptorType := kCoreEventClass;
|
|
dataHandle := aHandle;
|
|
END;
|
|
IF aHandle <> NIL THEN
|
|
BEGIN
|
|
WITH MsgHdrHdl(aHandle)^^ DO
|
|
BEGIN
|
|
msgAddrSize := msgAddrLen;
|
|
listClassHeader.hintIndex := 0;
|
|
inUse := FALSE;
|
|
inWaiting := FALSE;
|
|
waitLink := NIL;
|
|
userRefcon := 0;
|
|
thisAEEventClass := theAEEventClass;
|
|
thisAEEventID := theAEEventID;
|
|
WITH switchFromPSN DO
|
|
BEGIN
|
|
highLongOfPSN := 0;
|
|
lowLongOfPSN := 0;
|
|
END;
|
|
prevMsg := NIL;
|
|
notifyRecPtr := NIL;
|
|
accessMask := 0;
|
|
paramCount := 0;
|
|
END;
|
|
CreateBuffer := NoErr;
|
|
END
|
|
ELSE
|
|
CreateBuffer := MemError;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ make the descriptor at dataOffset into an AEDesc }
|
|
{ if the descriptor is AEList or AERecord, it is a special case that needs special
|
|
handling }
|
|
|
|
FUNCTION ExtractDescriptor(msg: MsgHdrHdl;
|
|
dataType: DescType;
|
|
dataSize, dataOffset, factorOut: LONGINT;
|
|
VAR res: AEDesc): OSErr;
|
|
{ note dataSize include the length that has been factored out }
|
|
|
|
VAR
|
|
flag: SignedByte;
|
|
err: OSErr;
|
|
aHandle: Handle;
|
|
aPtr: Ptr;
|
|
startPtr: CommonHeaderPointer;
|
|
|
|
BEGIN
|
|
flag := HGetState(Handle(msg));
|
|
HLock(Handle(msg));
|
|
aPtr := Ptr(ord(Handle(msg)^) + dataOffset);
|
|
IF (dataType = typeAERecord) OR (dataType = typeAEList) THEN
|
|
BEGIN { the case of AEList or AERecord }
|
|
{ first reserve the space }
|
|
{ err := PtrToHand(Ptr(ord(Handle(msg)^) + dataOffset - SizeOf(ListClassRec) -
|
|
factorOut), aHandle, RoundUp(dataSize + SizeOf(ListClassRec))); }
|
|
err := PtrToHand(Ptr(ord(Handle(msg)^) + dataOffset - SizeOf(ListClassRec) - factorOut),
|
|
aHandle, BAnd(dataSize + SizeOf(ListClassRec) + RoundUpValue,
|
|
roundUpMask));
|
|
IF err = NoErr THEN
|
|
BEGIN
|
|
{ we must do this first because sizeOfPrefix used below may be factored out }
|
|
{ it is possible that some of the data came from the factored header }
|
|
IF factorOut > 0 THEN { this must be list or reco }
|
|
{ + 8 belows because we want to skip the common type and size }
|
|
BlockMove(Ptr(ord(Handle(msg)^) + SizeOf(ListHdr) + 8), Ptr(ord(aHandle^) +
|
|
SizeOf(ListClassRec)), factorOut);
|
|
{ put in the list header }
|
|
WITH ListHdrHdl(aHandle)^^ DO
|
|
BEGIN
|
|
WITH listClassHeader DO
|
|
BEGIN
|
|
hintIndex := 0;
|
|
{ paramBegin := RoundUp(sizeOfPrefix + SizeOf(ListHdr)); }
|
|
paramBegin := BAnd(sizeOfPrefix + SizeOf(ListHdr) + RoundUpValue, roundUpMask);
|
|
metaCountOrObjType := LONGINT(dataType);
|
|
END;
|
|
END;
|
|
END;
|
|
END
|
|
ELSE
|
|
BEGIN { ordinary descriptor, just make it into a
|
|
handle }
|
|
err := PtrToHand(Ptr(ord(Handle(msg)^) + dataOffset - factorOut), aHandle, dataSize);
|
|
{ it is possible that some of the data came from the factored header }
|
|
IF (err = NoErr) AND (factorOut > 0) THEN
|
|
BlockMove(Ptr(ord(Handle(msg)^) + SizeOf(ListHdr) + 8), aHandle^, factorOut);
|
|
END;
|
|
HSetState(Handle(msg), flag);
|
|
WITH res DO
|
|
BEGIN
|
|
descriptorType := dataType;
|
|
dataHandle := aHandle;
|
|
END;
|
|
ExtractDescriptor := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ this is the basic routine to fetch a descriptor from an AppleEvent/AEList }
|
|
{ it find the descriptor, then call ExtractDescriptor and if the extracted
|
|
descriptor is of the wrong type, coercion is used }
|
|
|
|
FUNCTION FetchDesc(VAR theAEDescList: AEDescList; { VAR is for efficiency only }
|
|
index: LONGINT;
|
|
wantType: DescType;
|
|
VAR key: AEKeyWord;
|
|
VAR res: AEDesc): OSErr;
|
|
|
|
VAR
|
|
msgClass: DescClass;
|
|
msg: MsgHdrHdl;
|
|
startPtr: CommonHeaderPointer;
|
|
offset: LONGINT;
|
|
err: OSErr;
|
|
aHeaderInfoRec: HeaderInfoRec;
|
|
converted: AEDesc;
|
|
|
|
BEGIN
|
|
err := CheckDesc(theAEDescList, msgClass, TRUE);
|
|
msg := MsgHdrHdl(theAEDescList.dataHandle);
|
|
IF err = NoErr THEN
|
|
BEGIN
|
|
err := errAEDescNotFound;
|
|
FindDescOffset(msgClass, msg, index, key, offset, aHeaderInfoRec);
|
|
IF offset > 0 THEN
|
|
BEGIN
|
|
IF msgClass = classAevt THEN
|
|
SetAccessMask(msg, index);
|
|
{ since we now have AE_CoercePtr in addition to AE_CoerceDesc, we may take
|
|
advantage of it in future for better performance, but be careful about
|
|
'list' and factored list }
|
|
WITH aHeaderInfoRec DO
|
|
BEGIN
|
|
err := ExtractDescriptor(msg, aHeader.theType, aHeader.theLength, offset + headSize,
|
|
factorOut, res);
|
|
IF (LONGINT(wantType) <> LONGINT(aHeader.theType)) AND (LONGINT(wantType) <>
|
|
LONGINT(typeWildCard)) THEN
|
|
BEGIN { not the right type, but coercion may get
|
|
it }
|
|
{ We have the convention that any data type can have the same data structrue
|
|
as an AERecord, so coercion to/from AERecord is a simple assignment.
|
|
So the corecion to/from AERecord always succeed, AEM just assumes you
|
|
know what you are doing and you only coerce somthint to/from AERecord
|
|
if they have the same data structure as AERecord. But this means that
|
|
if the descriptor invovled here is an AERecord, you are asking for a
|
|
'PICT', then you get an AERecord which is declared as 'PICT' and hence
|
|
instant disaster. That is why we disallowed FetchDesc to fetch an
|
|
AERecord as anything other than an AERecord }
|
|
IF LONGINT(aHeader.theType) = LONGINT(typeAERecord) THEN
|
|
err := errAECoercionFail
|
|
ELSE { anything else we can try to coerce it }
|
|
err := AE_CoerceDesc(res, wantType, converted);
|
|
{ if there was an error, we can throw away the original }
|
|
{ if it succeed, we can throw away the original provided it is not the same as the converted result }
|
|
IF (err <> NoErr) OR (ord(res.dataHandle) <> ord(converted.dataHandle)) THEN
|
|
IgnoreOSErr(AE_DisposeDesc(res));
|
|
res := converted;
|
|
END;
|
|
END;
|
|
END;
|
|
END;
|
|
IF err <> NoErr THEN
|
|
NukeIt(res);
|
|
FetchDesc := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ Given a key or index, find the beginning offset of that descriptor }
|
|
{ if index <> 0, it is search by index, return the KeyWord in Key }
|
|
{ if index = 0, then it is search by KeyWord, return actual index in index }
|
|
|
|
{ aHeaderInfoRec returns all sort of information about the message and the item }
|
|
{ prefixSize factorOut headSize hasKey
|
|
list 0 0 8 F
|
|
record 0 0 12 T
|
|
list 4 0 4 F
|
|
record 4 0 8 T
|
|
list 8+ prefixSize-8 0 F
|
|
record 8+ prefixSize-8 4 T
|
|
AppleEvent 0 0 12 T }
|
|
|
|
PROCEDURE FindDescOffset(msgClass: DescClass;
|
|
msg: MsgHdrHdl;
|
|
VAR index: LONGINT;
|
|
VAR key: AEKeyWord;
|
|
VAR offset: LONGINT;
|
|
VAR aHeaderInfoRec: HeaderInfoRec);
|
|
|
|
LABEL 999;
|
|
|
|
VAR
|
|
startPtr: CommonHeaderPointer;
|
|
dataEnd: LONGINT;
|
|
|
|
varSize: BOOLEAN;
|
|
itemSize: LONGINT;
|
|
useKey: BOOLEAN;
|
|
lookingAt: LONGINT;
|
|
aLongPtr: LONGINTPtr;
|
|
|
|
BEGIN
|
|
WITH aHeaderInfoRec DO
|
|
BEGIN
|
|
offset := 0;
|
|
useKey := (index = 0);
|
|
IF msgClass >= classList THEN
|
|
BEGIN
|
|
hasKey := (msgClass = classReco);
|
|
prefixSize := ListHdrHdl(msg)^^.sizeOfPrefix;
|
|
{ copy the header in case it is factored to the prefix }
|
|
aHeader := CommonHeaderPointer(ord(msg^) + SizeOf(ListHdr) - 4)^;
|
|
varSize := (prefixSize <= 4);
|
|
IF varSize THEN
|
|
BEGIN
|
|
factorOut := 0;
|
|
headSize := 8 - prefixSize;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
factorOut := prefixSize - 8;
|
|
headSize := 0;
|
|
END;
|
|
IF hasKey THEN
|
|
headSize := headSize + 4;
|
|
{ now we have fill up according to the above table }
|
|
IF varSize THEN
|
|
{ so that itemSize would not include theLength field }
|
|
itemSize := headSize - 4
|
|
ELSE
|
|
WITH ListHdrHdl(msg)^^ DO
|
|
BEGIN
|
|
{ if fixed sized and search by index, just calculate the position }
|
|
{ in the fixed size case, itemSize is the fix length, minus the factorout and
|
|
add back the headSize because there may be a key }
|
|
itemSize := aHeader.theLength - factorOut + headSize;
|
|
IF itemSize <> 1 THEN { only round up if it is not packing, note
|
|
no key is implied }
|
|
itemSize := BAnd(itemSize + RoundUpValue, roundUpMask);
|
|
IF NOT useKey THEN
|
|
BEGIN { we may calculate the offset directly }
|
|
IF (index > 0) THEN
|
|
IF (index <= paramCount) THEN
|
|
BEGIN
|
|
offset := (index - 1) * itemSize + listClassHeader.paramBegin;
|
|
IF hasKey THEN
|
|
key := AEKeyWord(LONGINTPtr(ord(Handle(msg)^) + offset)^);
|
|
END;
|
|
GOTO 999;
|
|
END;
|
|
END;
|
|
END
|
|
ELSE
|
|
BEGIN { it is an AppleEvent }
|
|
hasKey := TRUE;
|
|
varSize := TRUE;
|
|
factorOut := 0;
|
|
prefixSize := 0;
|
|
headSize := 12;
|
|
itemSize := 8; { keyword + type }
|
|
END;
|
|
IF index < 0 THEN { we are not trying to get any item }
|
|
Exit(FindDescOffset);
|
|
IF msgClass = classMeta THEN
|
|
BEGIN
|
|
{ start point of search is just beyond 'aevt0101' }
|
|
{ end search at parameter BEGIN minus ';;;;' }
|
|
lookingAt := 1;
|
|
startPtr := CommonHeaderPointer(ord(Handle(msg)^) + BAnd(SizeOf(MsgHdr) -
|
|
SizeOf(TargetID) + msg^^.msgAddrSize + 8 + RoundUpValue, RoundUpMask));
|
|
dataEnd := ord(Handle(msg)^) + msg^^.listClassHeader.paramBegin - 4;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
lookingAt := msg^^.listClassHeader.hintIndex;
|
|
IF (lookingAt > 0) AND (index > 0) AND (index >= lookingAt) THEN
|
|
BEGIN
|
|
{ if this is beyond what we looked last time, we can start it from there }
|
|
startPtr := CommonHeaderPointer(ord(Handle(msg)^) + msg^^.listClassHeader
|
|
.hintOffset);
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
{ if we don't have hint, just start from the beginning }
|
|
{ note paramBegin is at the same position for both message and list }
|
|
lookingAt := 1;
|
|
startPtr := CommonHeaderPointer(ord(Handle(msg)^) + msg^^.listClassHeader
|
|
.paramBegin);
|
|
END;
|
|
dataEnd := ord(Handle(msg)^) + GetHandleSize(Handle(msg));
|
|
END;
|
|
WHILE ord(startPtr) < dataEnd DO
|
|
BEGIN
|
|
IF (lookingAt = index) OR (useKey AND (LONGINTPtr(startPtr)^ = LONGINT(key))) THEN
|
|
BEGIN
|
|
offset := ord(startPtr) - ord(Handle(msg)^);
|
|
IF hasKey THEN
|
|
key := startPtr^.theKeyword;
|
|
IF NOT (useKey OR (msgClass = classMeta)) THEN
|
|
BEGIN
|
|
WITH msg^^.listClassHeader DO
|
|
BEGIN
|
|
hintIndex := lookingAt;
|
|
hintOffset := offset;
|
|
END;
|
|
END;
|
|
index := lookingAt; { report where it was found }
|
|
LEAVE;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
startPtr := CommonHeaderPointer(ord(startPtr) + itemSize);
|
|
IF varSize THEN
|
|
{ startPtr := CommonHeaderPointer(ord(startPtr) + RoundUp(LONGINTPtr(startPtr)^ + 4)); }
|
|
startPtr := CommonHeaderPointer(ord(startPtr) + BAnd(LONGINTPtr(startPtr)^ +
|
|
4 + RoundUpValue,
|
|
roundUpMask));
|
|
END;
|
|
lookingAt := lookingAt + 1;
|
|
END;
|
|
END;
|
|
999:
|
|
IF offset > 0 THEN
|
|
WITH aHeaderInfoRec DO
|
|
BEGIN
|
|
aLongPtr := LONGINTPtr(ord(Handle(msg)^) + offset);
|
|
IF hasKey THEN
|
|
BEGIN { pointer was at the keyword }
|
|
aHeader.theKeyword := AEKeyWord(aLongPtr^);
|
|
aLongPtr := LONGINTPtr(ord(aLongPtr) + 4);
|
|
END;
|
|
IF prefixSize = 0 THEN
|
|
BEGIN { type is at the item header }
|
|
aHeader.theType := DescType(aLongPtr^);
|
|
aLongPtr := LONGINTPtr(ord(aLongPtr) + 4);
|
|
END;
|
|
IF prefixSize <= 4 THEN { size is at the item header }
|
|
aHeader.theLength := aLongPtr^;
|
|
END;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ find the first required keyword that has not been accessed }
|
|
|
|
FUNCTION FirstRequiredUnread(VAR theAppleEvent: AppleEvent; { VAR is for efficiency only }
|
|
VAR theKey: AEKeyWord): BOOLEAN;
|
|
|
|
VAR
|
|
aHeaderPtr: CommonHeaderPointer;
|
|
aPtr: Ptr;
|
|
i: LONGINT;
|
|
j: LONGINT;
|
|
maxSize: LONGINT;
|
|
optionalCount: LONGINT;
|
|
anOptsKey: AEKeyWord;
|
|
wantType: DescType;
|
|
alwaysFalse: BOOLEAN;
|
|
functionResult: BOOLEAN;
|
|
hasOptionList: BOOLEAN;
|
|
err: OSErr;
|
|
optDesc: AEDesc;
|
|
|
|
BEGIN
|
|
functionResult := FALSE;
|
|
{ get the list of optional parameters }
|
|
theKey := keyOptionalKeywordAttr;
|
|
hasOptionList := (FetchDesc(MakeMeta(theAppleEvent), 0, typeAEList, theKey, optDesc) = NoErr);
|
|
optionalCount := 0;
|
|
IF hasOptionList THEN
|
|
err := AE_CountItems(optDesc, optionalCount);
|
|
WITH MsgHdrHdl(theAppleEvent.dataHandle)^^ DO
|
|
BEGIN
|
|
alwaysFalse := (accessMask = 0);
|
|
aPtr := @accessMask;
|
|
IF (paramCount > 32) THEN
|
|
IF (accessMask <> 0) THEN
|
|
aPtr := Handle(accessMask)^; { if > 32 parameter, we have a handle }
|
|
aHeaderPtr := CommonHeaderPointer(ord(theAppleEvent.dataHandle^) + listClassHeader.
|
|
paramBegin);
|
|
FOR i := 0 TO paramCount - 1 DO
|
|
BEGIN { look at each parameter }
|
|
IF alwaysFalse OR (NOT BitTst(aPtr, i)) THEN
|
|
BEGIN { access bit is 0, so not yet accessed }
|
|
theKey := aHeaderPtr^.theKeyword; { this is the one }
|
|
functionResult := TRUE;
|
|
{ it was not accessed, but if it is optional that is OK, so check it }
|
|
FOR j := 1 TO optionalCount DO
|
|
BEGIN
|
|
{ this ReadData call should not move memory }
|
|
IF ReadData(optDesc, j, typeKeyword, theKey, wantType, @anOptsKey, 4, maxSize) =
|
|
NoErr THEN
|
|
IF (theKey = anOptsKey) THEN
|
|
BEGIN
|
|
functionResult := FALSE; { this is optional, doesn't count }
|
|
LEAVE;
|
|
END;
|
|
END;
|
|
IF functionResult THEN
|
|
LEAVE; { we found the missed required parameter }
|
|
END;
|
|
{ aHeaderPtr := CommonHeaderPointer(ord(aHeaderPtr) + RoundUp(aHeaderPtr^.theLength +
|
|
SizeOf(CommonHeader))); }
|
|
aHeaderPtr := CommonHeaderPointer(ord(aHeaderPtr) + BAnd(aHeaderPtr^.theLength +
|
|
SizeOf(CommonHeader) +
|
|
RoundUpValue, roundUpMask));
|
|
END;
|
|
END;
|
|
IF hasOptionList THEN
|
|
err := AE_DisposeDesc(optDesc);
|
|
FirstRequiredUnread := functionResult;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ this is the basic routine to get the attribute }
|
|
{ if it is a pseudo meta parameter, either calculate its position or calculate
|
|
its value }
|
|
{ otherwise it is fetched just like a meta parameter }
|
|
|
|
FUNCTION GetAttribute(VAR theAevt: AppleEvent; { VAR is for efficiency only }
|
|
key: AEKeyWord;
|
|
desiredType: DescType;
|
|
VAR typeCode: DescType;
|
|
dataPtr: Ptr;
|
|
maximumSize: LONGINT;
|
|
VAR actualSizeOrHandle: LONGINT;
|
|
wantDesc: BOOLEAN): OSErr;
|
|
|
|
VAR
|
|
err: OSErr;
|
|
result: AEDesc;
|
|
theDescClass: DescClass;
|
|
offset: LONGINT;
|
|
myPtr: Ptr;
|
|
flag: SignedByte;
|
|
enumAsInteger: INTEGER;
|
|
anEnum: OSType;
|
|
theAEEventSource: AEEventSource;
|
|
fromPSN: ProcessSerialNumber;
|
|
needCoercion: Boolean;
|
|
|
|
BEGIN
|
|
err := errAENotAEDesc;
|
|
IF (LONGINT(theAevt.descriptorType) = LONGINT(kCoreEventClass)) AND (theAevt.dataHandle <>
|
|
NIL) THEN
|
|
WITH MsgHdrHdl(theAevt.dataHandle)^^ DO
|
|
BEGIN
|
|
err := NoErr;
|
|
myPtr := NIL;
|
|
result.dataHandle := NIL;
|
|
actualSizeOrHandle := 4; { most common used value, use as default }
|
|
GetAttributeOffset(key, offset, typeCode);
|
|
IF offset > 0 THEN
|
|
BEGIN
|
|
myPtr := Ptr(ord(theAevt.dataHandle^) + offset);
|
|
END
|
|
ELSE IF LONGINT(key) = LONGINT(keyAddressAttr) THEN
|
|
BEGIN
|
|
myPtr := @msgAddrTarget;
|
|
actualSizeOrHandle := msgAddrSize;
|
|
typeCode := msgAddrType;
|
|
END
|
|
ELSE IF LONGINT(key) = LONGINT(keyEventSourceAttr) THEN
|
|
BEGIN { calculate the event source }
|
|
EventSource(MsgHdrHdl(theAevt.dataHandle), theAEEventSource, fromPSN);
|
|
enumAsInteger := INTEGER(theAEEventSource);
|
|
myPtr := @enumAsInteger;
|
|
actualSizeOrHandle := 2;
|
|
typeCode := typeShortInteger;
|
|
END
|
|
ELSE IF (LONGINT(key) = LONGINT(keyInteractLevelAttr)) AND (LONGINT(desiredType) <>
|
|
LONGINT(typeEnumerated)) THEN
|
|
BEGIN { get the interaction type and calculate the
|
|
interact level }
|
|
enumAsInteger := kAECanInteract;
|
|
IF ReadData(MakeMeta(theAevt), 0, typeEnumerated, key, typeCode, @anEnum, 4,
|
|
actualSizeOrHandle) = NoErr THEN
|
|
BEGIN
|
|
IF (LONGINT(anEnum) = LONGINT(kAlwaysInteract)) OR (LONGINT(anEnum) =
|
|
LONGINT(kAlwaysSwitchIfInteract)) THEN
|
|
enumAsInteger := kAEAlwaysInteract
|
|
ELSE IF LONGINT(anEnum) = LONGINT(kNeverInteract) THEN
|
|
enumAsInteger := kAENeverInteract;
|
|
END;
|
|
myPtr := @enumAsInteger;
|
|
actualSizeOrHandle := 2;
|
|
typeCode := typeShortInteger;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
{ for the rest of the attribute, we better make sure we have the reply first }
|
|
err := CheckDesc(theAevt, theDescClass, TRUE);
|
|
IF err = NoErr THEN
|
|
BEGIN
|
|
IF LONGINT(key) = LONGINT(keyMissedKeywordAttr) THEN
|
|
BEGIN { get the first missed required keyword }
|
|
IF FirstRequiredUnread(theAevt, AEKeyWord(anEnum)) THEN
|
|
BEGIN
|
|
myPtr := @anEnum;
|
|
actualSizeOrHandle := 4;
|
|
typeCode := typeKeyword;
|
|
END
|
|
ELSE
|
|
err := errAEDescNotFound;
|
|
END
|
|
ELSE
|
|
BEGIN { otherwise it is just a meta parameter }
|
|
IF wantDesc THEN
|
|
BEGIN { for descriptor use FetchDesc }
|
|
err := FetchDesc(MakeMeta(theAevt), 0, desiredType, key, result);
|
|
typeCode := result.descriptorType;
|
|
END
|
|
ELSE
|
|
BEGIN { for pointer data use ReadData }
|
|
err := ReadData(MakeMeta(theAevt), 0, desiredType, key, typeCode,
|
|
dataPtr, maximumSize, actualSizeOrHandle);
|
|
END;
|
|
END;
|
|
END;
|
|
END;
|
|
IF myPtr <> NIL THEN
|
|
BEGIN { it is not a regular meta parameter }
|
|
needCoercion := (LONGINT(desiredType) <> LONGINT(typeCode)) AND (LONGINT(desiredType) <>
|
|
LONGINT(typeWildCard)); { type does not match }
|
|
IF needCoercion OR wantDesc THEN { type does not match }
|
|
BEGIN
|
|
flag := HGetState(theAevt.dataHandle);
|
|
HLock(theAevt.dataHandle);
|
|
IF needCoercion THEN
|
|
BEGIN
|
|
err := AE_CoercePtr(typeCode, myPtr, actualSizeOrHandle, desiredType, result);
|
|
actualSizeOrHandle := 0; { in case it is 'true' }
|
|
typeCode := desiredType;
|
|
END
|
|
ELSE
|
|
BEGIN { type match, but we want a handle, so put it in }
|
|
err := AE_CreateDesc(typeCode, myPtr, actualSizeOrHandle, result);
|
|
END;
|
|
HSetState(theAevt.dataHandle, flag);
|
|
END;
|
|
IF (err = NoErr) AND (NOT wantDesc) THEN
|
|
BEGIN
|
|
IF result.dataHandle <> NIL THEN
|
|
BEGIN { result was coerced, so we need to change
|
|
value of myPtr }
|
|
myPtr := result.dataHandle^;
|
|
actualSizeOrHandle := GetHandleSize(result.dataHandle);
|
|
END;
|
|
IF dataPtr <> NIL THEN
|
|
BEGIN
|
|
IF maximumSize > actualSizeOrHandle THEN
|
|
maximumSize := actualSizeOrHandle;
|
|
BlockMove(myPtr, dataPtr, maximumSize);
|
|
END;
|
|
DisposHandle(result.dataHandle);
|
|
END;
|
|
END;
|
|
IF (err = NoErr) AND wantDesc THEN
|
|
actualSizeOrHandle := LONGINT(result.dataHandle); { return handle if it is desc }
|
|
END;
|
|
IF err <> NoErr THEN
|
|
BEGIN
|
|
actualSizeOrHandle := 0;
|
|
typeCode := typeNull;
|
|
END;
|
|
GetAttribute := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
PROCEDURE GetAttributeOffset(key: AEKeyWord;
|
|
VAR offset: LONGINT;
|
|
VAR dataType: DescType);
|
|
|
|
CONST
|
|
msgAddrTargetOffset = SizeOf(MsgHdr) - SizeOf(TargetID);
|
|
ReturnIDOffset = msgAddrTargetOffset - 8 - SizeOf(LONGINT);
|
|
eventIDOffset = ReturnIDOffset - SizeOf(AEEventClass);
|
|
eventClassOffset = eventIDOffset - SizeOf(AEEventID);
|
|
refconOffset = eventClassOffset - SizeOf(LONGINT);
|
|
|
|
VAR
|
|
offsetFromFront: INTEGER;
|
|
|
|
BEGIN
|
|
offsetFromFront := 0;
|
|
dataType := typeType; { most common value, use as default }
|
|
IF LONGINT(key) = LONGINT(keyEventClassAttr) THEN
|
|
BEGIN
|
|
offsetFromFront := eventClassOffset;
|
|
END
|
|
ELSE IF LONGINT(key) = LONGINT(keyEventIDAttr) THEN
|
|
BEGIN
|
|
offsetFromFront := eventIDOffset;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
dataType := typeLongInteger;
|
|
IF LONGINT(key) = LONGINT(keyReturnIDAttr) THEN
|
|
BEGIN
|
|
offsetFromFront := ReturnIDOffset;
|
|
END
|
|
ELSE IF LONGINT(key) = LONGINT(kAERefconAttribute) THEN
|
|
BEGIN
|
|
offsetFromFront := refconOffset;
|
|
END;
|
|
END;
|
|
offset := offsetFromFront;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ translate an desc to ptr and size, take into account it may be a list or record }
|
|
|
|
FUNCTION GetDescInfo(VAR theAEDesc: AEDesc; { VAR is for efficiency only }
|
|
VAR descInfo: DescInfoRec): OSErr;
|
|
|
|
VAR
|
|
err: OSErr;
|
|
|
|
BEGIN
|
|
WITH theAEDesc, descInfo DO
|
|
BEGIN
|
|
err := noErr;
|
|
IF dataHandle = NIL THEN
|
|
dataPtr := NIL
|
|
ELSE
|
|
dataPtr := dataHandle^;
|
|
dataSize := GetHandleSize(dataHandle);
|
|
dataType := descriptorType;
|
|
IF (LONGINT(descriptorType) = LONGINT(typeAEList)) OR (LONGINT(descriptorType) = LONGINT(typeAERecord)) THEN
|
|
BEGIN { skip the header if it is a list/record }
|
|
IF dataPtr = NIL THEN
|
|
err := errAENotAEDesc;
|
|
dataType := DescType(ListHdrPtr(dataPtr)^.listClassHeader.metaCountOrObjType); { real type in the record }
|
|
dataPtr := Ptr(ord(dataPtr)+SizeOf(ListClassRec));
|
|
dataSize := dataSize - SizeOf(ListClassRec);
|
|
END
|
|
ELSE IF LONGINT(dataType) = LONGINT(kCoreEventClass) THEN
|
|
BEGIN { we don't allow AppleEvent to be added as
|
|
descriptor }
|
|
err := errAEWrongDataType;
|
|
END;
|
|
IF err = noErr THEN { we lock it down so the ptr can be used }
|
|
BEGIN
|
|
flag := HGetState(dataHandle);
|
|
HLock(dataHandle);
|
|
END;
|
|
END;
|
|
GetDescInfo := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ if it is autoGenerateReturnID, then we make one up ourself }
|
|
|
|
FUNCTION MakeReturnID(ReturnID: LONGINT): LONGINT;
|
|
|
|
VAR
|
|
globalHandle: GlobalRecHandle;
|
|
anID: INTEGER;
|
|
|
|
BEGIN
|
|
globalHandle := GetGlobalRef;
|
|
IF ReturnID = kAutoGenerateReturnID THEN
|
|
BEGIN
|
|
IF globalHandle = NIL THEN
|
|
BEGIN
|
|
{ no global, just make a random one where high word cannot be 0 or -1 }
|
|
anID := $20000 + Random;
|
|
MakeReturnID := anID;
|
|
END
|
|
ELSE
|
|
WITH globalHandle^^ DO
|
|
BEGIN { we just add 1 to our counter }
|
|
ReturnIDCounter := ReturnIDCounter + 1;
|
|
{ ReturnID count must not have high word = 0 or -1 }
|
|
{ as we increment returnID, we would get up to $7FFFFFFF, $80000000 so on,
|
|
eventually to get to $FFFEFFFF, $FFFF0000 then we should skip ahead to
|
|
$00010000 }
|
|
IF (ReturnIDCounter = $FFFF0000) THEN
|
|
ReturnIDCounter := $10000;
|
|
MakeReturnID := ReturnIDCounter;
|
|
END;
|
|
END
|
|
ELSE
|
|
MakeReturnID := ReturnID;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
{ classify the type of AEDesc, and if waitReady is TRUE then if it is an AppleEvent then check
|
|
to see if reply is ready, also check for blocking }
|
|
|
|
FUNCTION CheckDesc(VAR theAEDescList: AEDescList;
|
|
VAR theDescClass: DescClass;
|
|
waitReady: BOOLEAN): OSErr;
|
|
|
|
VAR
|
|
theClass: DescClass; { shorter code if we use these two local
|
|
variables }
|
|
err: OSErr;
|
|
tempAppleEvent: AppleEvent;
|
|
|
|
BEGIN
|
|
err := NoErr;
|
|
WITH theAEDescList DO
|
|
BEGIN
|
|
IF dataHandle = NIL THEN
|
|
BEGIN
|
|
err := errAENotAEDesc;
|
|
theClass := classEmpty;
|
|
END
|
|
ELSE IF LONGINT(descriptorType) = LONGINT(kCoreEventClass) THEN
|
|
theClass := classAevt
|
|
ELSE IF LONGINT(descriptorType) = LONGINT(typeAEList) THEN
|
|
theClass := classList
|
|
ELSE IF LONGINT(descriptorType) = LONGINT(typeAERecord) THEN
|
|
theClass := classReco
|
|
ELSE IF LONGINT(descriptorType) = LONGINT(typeMeta) THEN
|
|
theClass := classMeta
|
|
ELSE
|
|
BEGIN
|
|
err := errAENotAEDesc;
|
|
theClass := classOther;
|
|
END;
|
|
theDescClass := theClass;
|
|
IF (theClass <= classAevt) THEN
|
|
BEGIN
|
|
WITH MsgHdrHdl(dataHandle)^^ DO
|
|
BEGIN
|
|
IF paramCount < 0 THEN
|
|
err := errAECorruptData
|
|
ELSE IF waitReady THEN
|
|
IF inWaiting THEN
|
|
BEGIN
|
|
tempAppleEvent := theAEDescList;
|
|
tempAppleEvent.descriptorType := kCoreEventClass;
|
|
IgnoreOSErr(TryBothProc(tempAppleEvent, blockingoffset)); { call blocking proc
|
|
if necessary }
|
|
{ we check again since thing may have been changed by the blocking proc }
|
|
{ we need to dereference again because memory may have been moved }
|
|
WITH MsgHdrHdl(dataHandle)^^ DO
|
|
BEGIN
|
|
IF paramCount < 0 THEN
|
|
err := errAECorruptData
|
|
ELSE IF inWaiting THEN
|
|
err := errAEReplyNotArrived;
|
|
END;
|
|
END;
|
|
END;
|
|
END;
|
|
END;
|
|
CheckDesc := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
{ this is the core routine for reading a descriptor into area pointed to by dataPtr }
|
|
{ if search by index, then index <> 0, if search by key, index = 0 }
|
|
|
|
FUNCTION ReadData(VAR theAEDescList: AEDescList; { VAR is for efficiency only }
|
|
index: LONGINT;
|
|
desiredType: DescType; { --> desired type }
|
|
VAR key: AEKeyWord; { --> the searchkey if index <> 0 }
|
|
{ <-- the actual key if index = 0 }
|
|
VAR typeCode: DescType; { <-- actual type }
|
|
dataPtr: Ptr;
|
|
maximumSize: LONGINT; { --> size of buffer }
|
|
VAR actualSize: LONGINT { <-- actual size of descriptor }
|
|
): OSErr;
|
|
|
|
VAR
|
|
startPtr: CommonHeaderPointer;
|
|
offset: LONGINT;
|
|
err: OSErr;
|
|
msg: MsgHdrHdl;
|
|
msgClass: DescClass;
|
|
aPtr: Ptr;
|
|
toBeConverted, converted: AEDesc;
|
|
aHeaderInfoRec: HeaderInfoRec;
|
|
dataSize, moved: LONGINT;
|
|
|
|
BEGIN
|
|
err := CheckDesc(theAEDescList, msgClass, TRUE);
|
|
msg := MsgHdrHdl(theAEDescList.dataHandle);
|
|
IF err = NoErr THEN
|
|
BEGIN
|
|
FindDescOffset(msgClass, msg, index, key, offset, aHeaderInfoRec);
|
|
IF offset > 0 THEN
|
|
BEGIN
|
|
typeCode := desiredType;
|
|
{ dataoffset is offset to beginning of that item in the list }
|
|
WITH aHeaderInfoRec DO
|
|
BEGIN
|
|
offset := offset + headSize; { skip the header, this is the real data }
|
|
aPtr := Ptr(ord(Handle(msg)^) + offset);
|
|
dataSize := aHeader.theLength - factorOut;
|
|
toBeConverted.dataHandle := NIL;
|
|
converted.dataHandle := NIL;
|
|
IF (LONGINT(aHeader.theType) <> LONGINT(desiredType)) AND (LONGINT(desiredType) <>
|
|
LONGINT(typeWildCard)) THEN
|
|
BEGIN { the type is not right, we need to do it by
|
|
coercion }
|
|
WITH aHeader DO { first just get it as is }
|
|
err := ExtractDescriptor(msg, theType, theLength, offset, factorOut,
|
|
toBeConverted);
|
|
IF err = NoErr THEN
|
|
BEGIN
|
|
{ since we now have AE_CoercePtr in addition to AE_CoerceDesc, in future
|
|
we can take advantage of it for better performance, but be careful about
|
|
'list' and factored list }
|
|
{ then we coerce it }
|
|
err := AE_CoerceDesc(toBeConverted, desiredType, converted);
|
|
{ dispose the as is copy if not same as the result }
|
|
IF toBeConverted.dataHandle <> converted.dataHandle THEN
|
|
IgnoreOSErr(AE_DisposeDesc(toBeConverted));
|
|
IF err = NoErr THEN
|
|
BEGIN
|
|
IF (LONGINT(converted.descriptorType) = LONGINT(typeAEList)) OR
|
|
(LONGINT(converted.descriptorType) = LONGINT(typeAERecord)) THEN
|
|
BEGIN { cannot read list or record into a buffer }
|
|
err := errAEWrongDataType;
|
|
END
|
|
ELSE
|
|
WITH converted DO
|
|
BEGIN
|
|
IF dataHandle <> NIL THEN
|
|
BEGIN
|
|
dataSize := GetHandleSize(dataHandle);
|
|
aPtr := dataHandle^;
|
|
HLock(dataHandle);
|
|
END
|
|
ELSE { in case it is 'true' }
|
|
dataSize := 0;
|
|
END;
|
|
factorOut := 0;
|
|
END;
|
|
END;
|
|
END
|
|
ELSE
|
|
typeCode := aHeader.theType;
|
|
IF (err = NoErr) AND (dataPtr <> NIL) THEN
|
|
BEGIN
|
|
moved := 0; { we have not moved anything yet }
|
|
IF factorOut > 0 THEN
|
|
BEGIN
|
|
moved := factorOut; { we plan to move factorOut data from the
|
|
prefix }
|
|
IF moved > maximumSize THEN
|
|
moved := maximumSize; { but only up to maximumSize }
|
|
BlockMove(Ptr(ord(Handle(msg)^) + SizeOf(ListHdr) + 8), dataPtr, moved);
|
|
maximumSize := maximumSize - moved; { we can still move that many bytes }
|
|
END;
|
|
IF maximumSize > dataSize THEN { but no more than the size of data }
|
|
maximumSize := dataSize;
|
|
BlockMove(aPtr, Ptr(ord(dataPtr) + moved), maximumSize); { move the non-facoted
|
|
part }
|
|
END;
|
|
actualSize := dataSize + factorOut;
|
|
IgnoreOSErr(AE_DisposeDesc(converted));
|
|
IF msgClass = classAevt THEN
|
|
SetAccessMask(msg, index);
|
|
END;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
err := errAEDescNotFound;
|
|
IF LONGINT(key) = LONGINT(aeRecTypeKeyword) THEN
|
|
IF (index = 0) AND (msgClass = classReco) THEN
|
|
BEGIN { it may be the pseudo keyword for the
|
|
record type }
|
|
IF (LONGINT(desiredType) = LONGINT(typeType)) OR (LONGINT(desiredType) =
|
|
LONGINT(typeWildCard)) THEN
|
|
BEGIN
|
|
typeCode := typeType;
|
|
actualSize := 4;
|
|
IF maximumSize >= 4 THEN
|
|
BEGIN
|
|
LONGINTPtr(dataPtr)^ := ListHdrHdl(msg)^^.listClassHeader.
|
|
metaCountOrObjType;
|
|
err := NoErr;
|
|
END;
|
|
END
|
|
END;
|
|
END;
|
|
END;
|
|
ReadData := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
{ set access mask to indicate that parameter has been accessed }
|
|
|
|
PROCEDURE SetAccessMask(msg: MsgHdrHdl;
|
|
index: LONGINT);
|
|
|
|
VAR
|
|
aHandle: Handle;
|
|
|
|
BEGIN
|
|
{ we want to mark it as being read }
|
|
IF msg^^.paramCount > 32 THEN
|
|
BEGIN
|
|
IF msg^^.accessMask = 0 THEN
|
|
BEGIN { we make a handle out of it }
|
|
aHandle := NewHandleClear(BSR(msg^^.paramCount + 7, 3));
|
|
msg^^.accessMask := LONGINT(aHandle);
|
|
END;
|
|
IF msg^^.accessMask <> 0 THEN
|
|
BitSet(Handle(msg^^.accessMask)^, index - 1);
|
|
END
|
|
ELSE
|
|
BitSet(@msg^^.accessMask, index - 1);
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
{ put the target address into an AppleEvent }
|
|
|
|
FUNCTION SetMsgAddress(theMsgHdrHdl: MsgHdrHdl;
|
|
typeCode: DescType;
|
|
dataPtr: Ptr;
|
|
dataSize: LONGINT): OSErr;
|
|
|
|
CONST
|
|
msgAddrTargetOffset = SizeOf(MsgHdr) - SizeOf(TargetID);
|
|
|
|
VAR
|
|
err: OSErr;
|
|
disp: LONGINT;
|
|
roundOldSize: LONGINT;
|
|
roundNewSize: LONGINT;
|
|
|
|
BEGIN
|
|
roundOldSize := BAnd(theMsgHdrHdl^^.msgAddrSize + RoundUpValue, RoundUpMask);
|
|
roundNewSize := BAnd(dataSize + RoundUpValue, RoundUpMask);
|
|
disp := Munger(Handle(theMsgHdrHdl), msgAddrTargetOffset, NIL, roundOldSize,
|
|
dataPtr, roundNewSize);
|
|
err := MemError;
|
|
IF err = NoErr THEN
|
|
WITH theMsgHdrHdl^^ DO
|
|
BEGIN
|
|
disp := roundNewSize - roundOldSize; { did the size changed ? }
|
|
msgAddrSize := dataSize;
|
|
msgAddrType := typeCode;
|
|
WITH listClassHeader DO
|
|
BEGIN
|
|
hintIndex := 0;
|
|
IF disp <> 0 THEN { if size changed, better adjust }
|
|
paramBegin := paramBegin + disp;
|
|
END;
|
|
END;
|
|
SetMsgAddress := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
{ this is the core routine to write a descriptor into a AEList/AppleEvent }
|
|
|
|
FUNCTION WriteData(VAR theAEDescList: AEDescList; { VAR is for efficiency only }
|
|
key: AEKeyWord;
|
|
dataType: DescType;
|
|
dataPtr: Ptr;
|
|
dataLength: LONGINT;
|
|
index: LONGINT;
|
|
numberOfItems: LONGINT): OSErr;
|
|
|
|
VAR
|
|
msgClass: DescClass;
|
|
msg: MsgHdrHdl;
|
|
testKey: AEKeyWord;
|
|
startPtr: CommonHeaderPointer;
|
|
offset, disp, toBeReplaced, replaceLength: LONGINT;
|
|
err: OSErr;
|
|
extraItem: INTEGER;
|
|
aHeaderInfoRec: HeaderInfoRec;
|
|
dummyHeaderInfoRec: HeaderInfoRec;
|
|
dummyKey: AEKeyWord;
|
|
packing: BOOLEAN;
|
|
aLongPtr: LONGINTPtr;
|
|
currentCount: LONGINT;
|
|
endingIndex: LONGINT;
|
|
endingOffset: LONGINT;
|
|
|
|
BEGIN
|
|
err := CheckDesc(theAEDescList, msgClass, FALSE);
|
|
msg := MsgHdrHdl(theAEDescList.dataHandle);
|
|
IF err = NoErr THEN
|
|
BEGIN
|
|
IF msgClass = classAevt THEN
|
|
WITH msg^^ DO
|
|
BEGIN
|
|
{ access mask will be all wrong anyway, in particular we want to avoid going from
|
|
32 parameter to 33 parameter and hence change the meaning of accessMask }
|
|
IF paramCount > 32 THEN { accessMask is really a handle }
|
|
DisposHandle(Handle(accessMask));
|
|
accessMask := 0;
|
|
END;
|
|
testKey := key;
|
|
IgnoreOSErr(AE_CountItems(theAEDescList, currentCount));
|
|
{ first find if there is such an item }
|
|
FindDescOffset(msgClass, msg, index, testKey, offset, aHeaderInfoRec);
|
|
IF dataPtr = NIL THEN
|
|
BEGIN
|
|
dataPtr := @dataLength; { we must put in some non-zero non-odd value
|
|
}
|
|
dataLength := 0;
|
|
END;
|
|
WITH aHeaderInfoRec DO
|
|
BEGIN
|
|
WITH aHeader DO
|
|
packing := (headSize = 0) AND ((theLength - factorOut) = 1);
|
|
IF offset <= 0 THEN
|
|
BEGIN { we did not have an entry yet }
|
|
{ key = '****' hasKey
|
|
true true error, require a key and we don't have one
|
|
false false error, adding a key desc to an ordinary list
|
|
false true add key desc to record, OK
|
|
true fasle add desc to list, OK }
|
|
IF (LONGINT(key) = LONGINT(typeWildCard)) = hasKey THEN
|
|
BEGIN
|
|
WriteData := errAEWrongDataType;
|
|
Exit(WriteData);
|
|
END
|
|
ELSE IF index <> 0 THEN { we have to check if we are writing to N+1
|
|
}
|
|
BEGIN
|
|
IF (index <> (currentCount + 1)) THEN
|
|
BEGIN
|
|
WriteData := errAEIllegalIndex;
|
|
Exit(WriteData);
|
|
END;
|
|
END;
|
|
toBeReplaced := 0;
|
|
IF msgClass = classMeta THEN { meta parameter go to just before the
|
|
';;;;' }
|
|
offset := MsgHdrHdl(msg)^^.listClassHeader.paramBegin - 4
|
|
ELSE IF (LONGINT(key) = LONGINT(keyDirectObject)) AND
|
|
(LONGINT(theAEDescList.descriptorType) = LONGINT(kCoreEventClass)) THEN
|
|
{ put direct object in front }
|
|
offset := MsgHdrHdl(msg)^^.listClassHeader.paramBegin
|
|
ELSE { put it at the end }
|
|
BEGIN
|
|
offset := GetHandleSize(Handle(msg));
|
|
END;
|
|
extraItem := 0; { we start with no item }
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
{ wildcard key means keep original key }
|
|
IF LONGINT(key) = LONGINT(typeWildCard) THEN
|
|
key := aHeader.theKeyword;
|
|
extraItem := - numberOfItems; { we are removing so many items }
|
|
IF numberOfItems > 1 THEN { we want to replace more than 1 items }
|
|
BEGIN
|
|
endingIndex := index + numberOfItems;
|
|
IF endingIndex > currentCount THEN
|
|
BEGIN
|
|
toBeReplaced := GetHandleSize(Handle(msg)) - offset;
|
|
extraItem := index - currentCount - 1; { negative of items left at end }
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
{ we find the end of the range so that we know how many to replace }
|
|
FindDescOffset(msgClass, msg, endingIndex, dummyKey, endingOffset,
|
|
dummyHeaderInfoRec);
|
|
toBeReplaced := endingOffset - offset;
|
|
END;
|
|
END
|
|
ELSE
|
|
BEGIN { only trying to do to one item }
|
|
IF packing THEN { then we only have 1 byte }
|
|
toBeReplaced := 1
|
|
ELSE { this is the length in the item plus any
|
|
associated header }
|
|
toBeReplaced := BAnd(aHeader.theLength + headSize - factorOut +
|
|
RoundUpValue, roundUpMask);
|
|
END;
|
|
END;
|
|
{ since ptr point to the factored data, we should reduce headSize by size of prefix data }
|
|
IF ord(dataPtr) = - 1 THEN
|
|
BEGIN
|
|
dataPtr := @dataLength; { we must put in some non-zero non-odd value
|
|
}
|
|
replaceLength := 0; { new length is 0 }
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
{ since we are adding element, we need to check if it agrees with the prefix }
|
|
WITH aHeader DO
|
|
BEGIN
|
|
{ if there is a prefix, we check if see the new item agree with prefix }
|
|
IF ((prefixSize >= 8) AND (theLength <> dataLength)) OR ((prefixSize >= 4) AND
|
|
(theType <> dataType)) THEN
|
|
BEGIN
|
|
WriteData := errAEBadListItem;
|
|
Exit(WriteData);
|
|
END;
|
|
END;
|
|
extraItem := extraItem + 1; { we are adding 1 item back }
|
|
IF packing THEN { length is always 1 for packing }
|
|
replaceLength := 1
|
|
ELSE { this is the length of the new item }
|
|
replaceLength := BAnd(dataLength + headSize - factorOut + RoundUpValue,
|
|
roundUpMask);
|
|
END;
|
|
{ and now we insert/replace/delete the item }
|
|
disp := Munger(Handle(msg), offset, NIL, toBeReplaced, Ptr(ord(dataPtr) -
|
|
headSize + factorOut),
|
|
replaceLength);
|
|
|
|
err := MemError;
|
|
IF (extraItem >= 0) AND (err = NoErr) THEN
|
|
BEGIN { it is not a delete }
|
|
aLongPtr := LONGINTPtr(ord(Handle(msg)^) + offset);
|
|
IF hasKey THEN
|
|
BEGIN { put in the keyword }
|
|
aLongPtr^ := LONGINT(key);
|
|
aLongPtr := LONGINTPtr(ord(aLongPtr) + 4);
|
|
END;
|
|
IF prefixSize = 0 THEN
|
|
BEGIN { type is not uniform, so it is in the
|
|
header }
|
|
aLongPtr^ := LONGINT(dataType);
|
|
aLongPtr := LONGINTPtr(ord(aLongPtr) + 4);
|
|
END;
|
|
IF prefixSize <= 4 THEN { size is not uniform, so it is in the
|
|
header }
|
|
aLongPtr^ := dataLength;
|
|
END;
|
|
END;
|
|
IF err = NoErr THEN
|
|
WITH MsgHdrHdl(msg)^^ DO
|
|
BEGIN
|
|
listClassHeader.hintIndex := 0; { invalidate hint on write }
|
|
IF msgClass = classMeta THEN
|
|
WITH listClassHeader DO
|
|
BEGIN
|
|
paramBegin := paramBegin + replaceLength - toBeReplaced;
|
|
metaCountOrObjType := metaCountOrObjType + extraItem;
|
|
END
|
|
ELSE { paramCount has same position for aevt,
|
|
list and reco }
|
|
BEGIN
|
|
paramCount := paramCount + extraItem;
|
|
END;
|
|
END;
|
|
END;
|
|
WriteData := err;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|