mirror of
https://github.com/elliotnunn/sys7.1-doc-wip.git
synced 2024-06-01 04:41:39 +00:00
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;
|
|
|
|
{--------------------------------------------------------------------------------}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|