supermario/base/SuperMarioProj.1994-02-09/Toolbox/AppleEventMgr/AEDF.inc1.p
2019-06-29 23:17:50 +08:00

1151 lines
49 KiB
OpenEdge ABL

{
File: AEDF.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
Change History (most recent first):
<18> 3/15/91 Lai BM,#83128: Remove notification when interacting with event from
another process.
<17> 2/5/91 Lai BM,#81595: Set the descriptorType of reply parameter in the
handler to 'null' when there is no reply requested.
<16> 1/11/91 Lai Processing another AppleEvent in WaitReply loop no longer drop
out of the loop.
<15> 12/14/90 gbm <jdr> Correct spelling of rtrnReceiptMsgID
<14> 12/13/90 Lai Separation of the main files into separate modules
<13> 10/29/90 Lai Return an error if receipt indicates that server did not accept
the AppleEvent fully. Also round up any AppleEvent buffer to
even length (already the case if message send from AEM, this is
to take care of those who don't use AEM to send AppleEvent).
<12> 10/3/90 gbm NMRecPtr are no longer QElemPtr, but really NMRecPtr.
<11> 9/25/90 Lai Bug fix for jfr0009, change order of parameter in special
handler calls
<10> 9/21/90 Lai Send actual timeout value rather than timeout constant (e.g.-1)
in message.
<9> 9/20/90 Lai Do not allow installing illegal handlers (NIL or odd)
<8> 9/19/90 Lai pass back return ID in the wait reply filter, handle
AEInteractionWithUser when not processing an AppleEvent.
<7> 9/19/90 Lai In the waitloop, generate the first null event by calling
OSEventAvail so that other fields will be filled.
<6> 9/18/90 Lai Use refcon as the return ID, and put the transaction ID back as
meta parameter
<5> 9/15/90 ngk fix for names changes in PPCToolBox.p
<4> 9/15/90 Lai don't use modifiers as returnID in receipt
<3> 9/15/90 Lai Post code review cleanup, idle proc now recieve
update/suspend/activate event
<2+> 9/13/90 Lai Post code review cleanup
<2> 9/10/90 Lai Type coercion OSType to LONGINT for better compil under 3.0
compiler.
<1> 9/7/90 Lai first checked in
<0> 9/7/90 Lai First Checked in.
To Do:
}
{$P}
{ AEDF.inc1.p }
{ Copyright © 1984-1990 by Apple Computer Inc. All rights reserved. }
{--------------------------------------------------------------------------------}
CONST
kFirstLegalReply = kAENoReply;
kLstLegalRely = kAEWaitReply;
TYPE
EppcAddress = RECORD
postingOptions: LONGINT;
sendToAddr: Ptr;
END;
{--------------------------------------------------------------------------------}
FUNCTION CallNotAppleEvent(sender: TargetID;
msgRefcon: LONGINT;
theAEEventClass: AEEventClass;
theAEEventID: AEEventID;
msgBuffer: Ptr;
msgLen: LONGINT;
callproc: ProcPtr): OSErr;
{ inline is equivalent to : movea.l (a7)+,a0; jsr (a0) }
INLINE $205F, $4E90;
{--------------------------------------------------------------------------------}
FUNCTION DoExtraFilter(VAR theMsgEvent: EventRecord;
returnID: LONGINT;
eventRefCon: LONGINT;
sender: AEAddressDesc;
callproc: ProcPtr): Boolean;
{ inline is equivalent to : movea.l (a7)+,a0; jsr (a0) }
INLINE $205F, $4E90;
{--------------------------------------------------------------------------------}
FUNCTION CallTableDispatch(msg, theReply: AppleEvent;
refcon: LONGINT;
callproc: ProcPtr): OSErr;
{ inline is equivalent to : movea.l (a7)+,a0; jsr (a0) }
INLINE $205F, $4E90;
{--------------------------------------------------------------------------------}
FUNCTION CheckAppleEvent(VAR theAppleEvent: AppleEvent): OSErr; { VAR is for efficiency only }
FORWARD;
FUNCTION CreateDefaultReply(VAR origMsg: AppleEvent; { VAR is for efficiency only }
VAR theReply: AppleEvent { --> the reply }
): OSErr;
FORWARD;
FUNCTION PeekMetaParameter(EPPCBuff: HighLevelEventMsgPtr; { the EPPC msg buffer }
theAttribute: AEKeyWord; { look for this key word }
VAR isAevt: Boolean; { does it look like an AppleEvent? }
VAR theValue: LONGINT { value of the keyword attribute }
): Boolean;
FORWARD;
PROCEDURE PullOffTheQueue;
FORWARD;
FUNCTION SendMessage(theMsg: MsgHdrHdl;
sendMode: LONGINT;
sendPriority: integer; { AEHighPriority, AENormalPriority }
timeOut: LONGINT; { sender's timeout in ticks }
waitingHook: ProcPtr; {Routine to call to spin the cursor}
extraHandlingFilter: ProcPtr { extra event processing filter }
): OSErr;
FORWARD;
FUNCTION SendWithReply(VAR msg: AppleEvent; { VAR is for efficiency only }
VAR reply: AppleEvent; {Uninitialized, we create it(pass to createmsg)}
isWaitReply: Boolean; { Queue or Wait for a reply after sending }
sendPriority: integer; { AEHighPriority, AENormalPriority }
sendMode: LONGINT;
timeOut: LONGINT; {sender's timeout in ticks}
waitingHook: ProcPtr; {Routine to call to spin the cursor}
extraHandlingFilter: ProcPtr { extra event processing filter }
): OSErr;
FORWARD;
FUNCTION TryEppcFail(theMsg: MsgHdrHdl;
toType: DescType;
VAR coercedTarget: AEDesc): Boolean;
FORWARD;
{--------------------------------------------------------------------------------}
{ Used internally to send message buffers. Called from a routine inside AESend }
{ Uses EPPC to send a message and wait for a receipt if required. }
PROCEDURE AddrTypeToPostingOptions(addrType: LONGINT;
addrPtr: Ptr;
VAR address: EppcAddress);
{ return eppc posting option and address depending on address type }
BEGIN
WITH address DO
IF addrType = LONGINT(typeSessionID) THEN
BEGIN
postingOptions := receiverIDisSessionID;
sendToAddr := Ptr(LONGINTPtr(addrPtr)^);
END
ELSE IF addrType = LONGINT(typeTargetID) THEN
BEGIN
postingOptions := receiverIDisTargetID;
sendToAddr := addrPtr;
END
ELSE IF addrType = LONGINT(typeProcessSerialNumber) THEN
BEGIN
postingOptions := receiverIDisPSN;
sendToAddr := addrPtr;
END
ELSE IF addrType = LONGINT(typeApplSignature) THEN
BEGIN
postingOptions := receiverIDisSignature;
sendToAddr := Ptr(LONGINTPtr(addrPtr)^);
END
ELSE
BEGIN
postingOptions := 0;
END;
END;
{--------------------------------------------------------------------------------}
{ All dispatching goes through AEMDispatcher. }
{ We try dispatching in the following order until it is handled }
{ 1. application's preHandler proc }
{ 2. application's dispatch table }
{ 3. system's preHandler proc }
{ 4. system's dispatch table }
FUNCTION AEMDispatcher(VAR msgDesc: AppleEvent; { --> Pass the message to the handler}
VAR theReply: AppleEvent; { --> put reply here }
handlerRefcon: LONGINT): OSErr;
VAR
err: OSErr;
aLongErr: LONGINT;
dummySize: LONGINT;
returnType: DescType; {Dummy for return of replyrequested}
FUNCTION TryEventTable(aGlobalRef: GlobalRecHandle): OSErr;
VAR
theHandlerRec: HandlerRec;
err: OSErr;
BEGIN
err := errAEEventNotHandled;
IF aGlobalRef <> NIL THEN
BEGIN
{ if we have a PreHandler dispatch, go through it first }
WITH aGlobalRef^^ DO
IF phacProcPtr <> NIL THEN
err := CallTableDispatch(msgDesc, theReply, 0, phacProcPtr);
IF err = errAEEventNotHandled THEN
BEGIN
{ search the table for a handler }
WITH MsgHdrHdl(msgDesc.dataHandle)^^, aGlobalRef^^ DO
IF aeHashTable <> NIL THEN
IF GetTableInfo(aeHashTable, thisAEEventClass, thisAEEventID,
theHandlerRec) THEN
WITH theHandlerRec DO
IF theProc <> NIL THEN { we have dispatch table entry }
err := CallTableDispatch(msgDesc, theReply, theRefCon, theProc);
END;
END;
TryEventTable := err;
END;
BEGIN
err := TryEventTable(GetGlobalRef); { try the application specific dispatch }
IF err = errAEEventNotHandled THEN err := TryEventTable(GetSysGlobal); { not there, then try
the system wid one }
AEMDispatcher := err; { Return Err from dispatch to Server }
END;
{--------------------------------------------------------------------------------}
{ we first create a empty message and read in the content, then check if it is
a AppleEvent, if it is we process it by dispatching }
{ if it is an 'aevt' 'ansr', we look at our pending list and put the result there }
FUNCTION AE_ProcessAppleEvent(VAR theEventRecord: EventRecord): OSErr; { --> how should this be
passed? }
LABEL 999, 1000;
VAR
theAEEventClass: AEEventClass;
theAEEventID: AEEventID;
theReply: AppleEvent; {AEMDispatcher initializes this, we send it }
msgDesc: AppleEvent;
msgLen: LONGINT; {msgLen is returned by AcceptEPPC }
theRefCon: LONGINT;
err: OSErr;
tempErr: OSErr;
sender: TargetID; {Get from AcceptHighLevelEvent}
msgBufPtr: Ptr;
aGlobalRef: GlobalRecHandle;
returnType: DescType; {Dummy for return of replyrequested}
dummySize: LONGINT; {used for size of repq = 0}
matchWaitList: Boolean;
aLongPtr: LONGINTPtr;
i: integer;
myAENotifyRec: AENotifyRec;
metaDesc: AppleEvent;
curMsgHdl: MsgHdrHdl;
BEGIN
IgnoreOSErr(MustHaveGlobal(FALSE, aGlobalRef));
WITH theEventRecord DO
BEGIN
theAEEventClass := AEEventClass(message);
theAEEventID := AEEventID(where);
END;
msgDesc.dataHandle := NIL; {so it won't be free by mistake}
NukeIt(theReply); {so it won't be free by mistake}
matchWaitList := FALSE;
msgLen := 0;
err := AcceptHighLevelEvent(sender, theRefCon, NIL, msgLen); {Get the length of data}
{ we first check if it for a pending reply, because then we have to read directly
into the waiting reply }
IF (LONGINT(theAEEventID) = LONGINT(kAEAnswer)) AND (LONGINT(theAEEventClass) =
LONGINT(kCoreEventClass)) AND (aGlobalRef <> NIL) THEN
BEGIN { we check through our list to see if we are waiting for this }
curMsgHdl := aGlobalRef^^.waitReplyList; { start looking from the head of the list }
WHILE curMsgHdl <> NIL DO
BEGIN
WITH curMsgHdl^^ DO
IF ReturnID = theRefCon THEN { id matches, this is the one }
BEGIN
msgDesc.descriptorType := kCoreEventClass;
msgDesc.dataHandle := Handle(curMsgHdl);
matchWaitList := TRUE;
LEAVE;
END
ELSE
curMsgHdl := waitLink; { otherwise check with the next one }
END;
END;
IF err = bufferIsSmall THEN
BEGIN { we do have a message content }
IF matchWaitList THEN { we already have a message waiting }
WITH MsgHdrHdl(msgDesc.dataHandle)^^ DO
BEGIN
{ leave enought room to read it in }
SetHandleSize(msgDesc.dataHandle, SizeOf(MsgHdr) - SizeOf(TargetID) +
msgAddrSize + msgLen);
err := MemError;
END
ELSE { otherwise we create a new message for reading }
BEGIN
err := CreateBuffer(BAnd(msgLen - SizeOf(AEMetaDesc) + RoundUpValue, RoundUpMask),
SizeOf(TargetID), theAEEventClass, theAEEventID, msgDesc);
END;
{ we are unlikely to be able even to reply failure, just bail out }
IF (err <> noErr) THEN GOTO 999;
HLock(msgDesc.dataHandle);
WITH MsgHdrHdl(msgDesc.dataHandle)^^ DO
BEGIN
msgAddrType := typeTargetID;
msgAddrSize := SizeOf(TargetID);
msgBufPtr := Ptr(ord(msgDesc.dataHandle^) + SizeOf(MsgHdr) -
SizeOf(TargetID) + msgAddrSize); {skip AEM's secret data}
{ data is read into the buffer, targetID, refcon is also read directly into message header }
err := AcceptHighLevelEvent(msgAddrTarget.asTargetID, ReturnID, msgBufPtr, msgLen);
END;
HUnLock(msgDesc.dataHandle);
END
ELSE IF err = noErr THEN
BEGIN { there is no content in the message }
IF NOT matchWaitList THEN
WITH MsgHdrHdl(msgDesc.dataHandle)^^ DO
err := CreateBareMessage(SizeOf(TargetID), theAEEventClass, theAEEventID,
theRefCon, kAnyTransactionID, msgDesc); { create an
empty message }
IF (err = noErr) THEN
BEGIN
WITH MsgHdrHdl(msgDesc.dataHandle)^^ DO
BEGIN
msgAddrType := typeTargetID;
msgAddrSize := SizeOf(TargetID);
msgAddrTarget.asTargetID := sender; {Make an addressObject out of the targetID from
Accetp...}
END;
END;
END;
IF err = NoErr THEN
BEGIN
err := CheckMessage(MsgHdrHdl(msgDesc.dataHandle));
{ we call the nonAevtHandler if we cannot understand the message }
IF (err = noErr) THEN
BEGIN
IF NOT matchWaitList THEN
BEGIN
metaDesc := MakeMeta(msgDesc);
{ if either there is a 'repq' or 'timo' keyword, we want a reply }
IF (AE_SizeOfKeyDesc(metaDesc, keyTimeoutAttr, returnType, dummySize) = noErr) |
(AE_SizeOfKeyDesc(metaDesc, kReplyRequestedKeyword, returnType, dummySize) =
noErr) THEN
BEGIN
err := CreateDefaultReply(msgDesc, theReply);
IF err <> noErr THEN GOTO 999;
END;
err := AE_ResumeTheCurrentEvent(msgDesc, theReply, @AEMDispatcher, 0);
GOTO 1000; { just return the error, no need to handle the error }
END;
END
ELSE IF (aGlobalRef <> NIL) THEN { error from CheckMessage, then call non-AppleEvent
handler if there is one }
WITH aGlobalRef^^ DO
IF (AENonAevtHandler <> NIL) THEN
BEGIN
HLock(Handle(msgDesc.dataHandle));
tempErr := CallNotAppleEvent(sender, theRefCon, theAEEventClass,
theAEEventID, msgBufPtr, msgLen,
AENonAevtHandler);
HUnLock(Handle(msgDesc.dataHandle));
IF tempErr <> noErr THEN err := tempErr;
END;
END;
999:
IF matchWaitList THEN
BEGIN
OffWaitList(MsgHdrHdl(msgDesc.dataHandle)); { we got it, no need to wait any more }
WITH MsgHdrHdl(msgDesc.dataHandle)^^ DO
BEGIN
inWaiting := FALSE;
IF err <> noErr THEN paramCount := - 1; { indicate corrupt data }
END;
{ if we need to unblock thread, here is the place to do it }
IgnoreOSErr(TryBothProc(msgDesc, unblockOffset));
END
ELSE IF err <> noErr THEN DisposHandle(msgDesc.dataHandle);
1000:
AE_ProcessAppleEvent := err;
END;
{--------------------------------------------------------------------------------}
{ finish process this event by first setting it to current, then execute the
dispatch routine or redispatch it, send the result back and then dispose
the message and the reply }
{ it should be noted that the processing of an AppleEvent and the send-direct
execution also calls this procedure, this is so that it can establish the
message as the current event being processed and then dispatched, therefore
we need to check for the send-direct case so we won't dispose the message }
FUNCTION AE_ResumeTheCurrentEvent(VAR theAppleEvent, reply: AppleEvent; { VAR is for efficiency only
}
dispatcher: EventHandlerProcPtr;
handlerRefcon: Longint): OSErr;
LABEL
999;
VAR
err: OSErr;
sendErr: OSErr; { holding place for send error before we decide which error to report}
aGlobalRef: GlobalRecHandle;
aLongErr: LONGINT;
thePSN: ProcessSerialNumber;
tempIcon: Handle;
returnType: DescType; {Dummy for return of replyrequested}
dummySize: LONGINT; {used for size of repq = 0}
sendToSelf: Boolean;
BEGIN
err := CheckAppleEvent(theAppleEvent);
IF (err <> noErr) THEN goto 999;
aGlobalRef := GetGlobalRef;
IgnoreOSErr(AE_SetTheCurrentEvent(theAppleEvent));
sendToSelf := (LONGINT(MsgHdrHdl(theAppleEvent.dataHandle)^^.msgAddrType) = LONGINT(typeProcessSerialNumber));
IF ord(dispatcher) = kAEUseStandardDispatch THEN dispatcher := @AEMDispatcher;
IF dispatcher <> NIL THEN
err := CallTableDispatch(theAppleEvent, reply, handlerRefcon, dispatcher);
WITH MsgHdrHdl(theAppleEvent.dataHandle)^^ DO
BEGIN
thePSN := switchFromPSN; { get the value before event is disposed }
notifyRecPtr := NIL; { no longer has a notification, assocaited with the message }
END;
sendErr := noErr;
IF (aGlobalRef <> NIL) AND
(aGlobalRef^^.currentMsg = MsgHdrHdl(theAppleEvent.dataHandle)) THEN
BEGIN { it finished without suspension }
IF reply.dataHandle <> NIL THEN
BEGIN
IF err <> noErr THEN
BEGIN
IF AE_GetKeyPtr(reply, keyErrorNumber, typeLongInteger, returnType, NIL, 0,
dummySize) <> noErr THEN
BEGIN { if the application is not already reporting, we shall }
aLongErr := err; { extend to 32 bit }
IgnoreOSErr(AE_PutKeyPtr(reply, keyErrorNumber, typeLongInteger, @aLongErr,
4)); { we report back error }
END;
END;
IF NOT sendToSelf THEN
BEGIN { we know it is not send to self }
{ Send the Reply, don't worry about a receipt }
sendErr := SendMessage(MsgHdrHdl(reply.dataHandle), 0,
kAENormalPriority, 0, NIL, NIL);
END;
IF err = noErr THEN err := sendErr;
IgnoreOSErr(AE_DisposeDesc(reply)); {dispose of the Reply}
END;
IgnoreOSErr(AE_SuspendTheCurrentEvent(theAppleEvent));
IgnoreOSErr(AE_DisposeDesc(theAppleEvent)); {dispose of the message}
END
ELSE
BEGIN
{ we were being suspended, for the direct call case, this is equivalent to a time out error }
IF sendToSelf THEN err := errAETimeout;
END;
{ IF (thePSN.lowLongOfPSN <> 0) OR (thePSN.highLongOfPSN <> 0) THEN }
IF BOr(thePSN.lowLongOfPSN, thePSN.highLongOfPSN) <> 0 THEN
IgnoreOSErr(SetFrontProcess(thePSN)); { if we don't need to switch back thePSN is 0 so
nothing happenss otherwise we switch back }
999:
AE_ResumeTheCurrentEvent := err;
END;
{--------------------------------------------------------------------------------}
{
Send this message to the server
Client: still owns the msg desc and the reply and must eventually deallocate.
Server: gives up control of reply desc.
If Client == Server
short circut the send and not go through EPPC
Client <> Server
Set up calls to EPPC and sends
If receipt is wanted
...wait for for return receipt
If waitReply, then
...wait in Eventavail loop for reply message
}
FUNCTION AE_Send(VAR theAppleEvent: AppleEvent; { --> send this one, VAR is for efficiency only }
VAR reply: AppleEvent; { <-- return reply here, AEM does NewHandle }
sendMode: AESendMode; { --> e.g. AENoReply, AEWaitReply OR AEWithReceipt }
sendPriority: AESendPriority; { --> e.g. AEHighPrioirty, AENormalPriority }
timeOutInTicks: LONGINT; { --> number of ticks to wait for reply }
idleProc: IdleProcPtr; { Routine to call to spin the cursor }
filterProc: EventFilterProcPtr): OSErr;
LABEL 999;
VAR
theAEEventClass: AEEventClass;
theAEEventID: AEEventID;
sendToSelf: Boolean;
dummyType: DescType;
interaction: OSType;
actualSize: LONGINT;
tempReply: AppleEvent;
err: OSErr;
aGlobalRef: GlobalRecHandle;
theSendMode: Integer;
BEGIN
NukeIt(tempReply); { nil our internal copy of reply first }
err := CheckAppleEvent(theAppleEvent);
IF err <> noErr THEN goto 999;
WITH MsgHdrHdl(theAppleEvent.dataHandle)^^ DO
BEGIN
theAEEventClass := thisAEEventClass;
theAEEventID := thisAEEventID;
sendToSelf := FALSE;
{ check to see if short circut is possible }
IF LONGINT(msgAddrType) = LONGINT(typeProcessSerialNumber) THEN
WITH msgAddrTarget.asPSN DO
IF lowLongOfPSN = kCurrentProcess THEN
IF highLongOfPSN = 0 THEN
sendToSelf := TRUE;
END;
theSendMode := BAnd(sendMode, kAEProtocolMask); { Mask of the receipt for comparision }
CASE BAnd(sendMode, kAEInteractMask) OF
$00,$40:
WITH MsgHdrHdl(theAppleEvent.dataHandle)^^ DO
BEGIN
{ the user did not provide one, we determine it for them }
IF (msgAddrType = typeTargetID) AND
(msgAddrTarget.asTargetID.location.locationKindSelector <> ppcNoLocation) THEN
interaction := kNeverInteract { default is no interact for remote machine }
ELSE IF theSendMode = kAEWaitReply THEN
interaction := kCanSwitchIfInteract { wait reply to same machine should be
switchable }
ELSE
interaction := kCanInteract;
END;
$10, $50: interaction := kNeverInteract;
$20: interaction := kCanInteract;
$30: interaction := kAlwaysInteract;
$60: interaction := kCanSwitchIfInteract;
$70: interaction := kAlwaysSwitchIfInteract;
{ OTHERWISE
BEGIN
err := errAEUnknownSendMode;
GOTO 999;
END; }
END;
{ we put in the interact level attribute }
IF (LONGINT(interaction) <> LONGINT(kCanInteract)) | (AE_GetKeyPtr(MakeMeta(theAppleEvent),
kInteractLevelKeyword,
typeEnumerated,
dummyType, NIL, 4,
actualSize) = noErr) THEN
BEGIN
err := WriteData(MakeMeta(theAppleEvent), kInteractLevelKeyword, typeEnumerated,
@interaction, SizeOf(interaction), 0, 1);
IF err <> noErr THEN GOTO 999;
END;
IF (theSendMode < kFirstLegalReply) OR (theSendMode > kLstLegalRely) THEN
err := errAEUnknownSendMode
ELSE IF sendToSelf THEN
BEGIN
{ this is the short circuit direct send case }
{ since the same message is used by both the client and the server we need to
take some precaution, we set the in use flag so that we know it will be
shared and we clean up the access mask }
IF theSendMode <> kAENoReply THEN
BEGIN
err := CreateDefaultReply(theAppleEvent, tempReply);
IF err <> noErr THEN GOTO 999;
MsgHdrHdl(tempReply.dataHandle)^^.inUse := TRUE; { about to be used by the server
too }
END;
WITH MsgHdrHdl(theAppleEvent.dataHandle)^^ DO
BEGIN
inUse := TRUE;
{ make sure we have a clean copy of the access mask }
IF paramCount > 32 THEN { accessMask is a handle, dispose it }
DisposHandle(Handle(accessMask));
accessMask := 0;
END;
err := AE_ResumeTheCurrentEvent(theAppleEvent, tempReply, @AEMDispatcher, 0);
END
ELSE
BEGIN { not to self, then actually send a message }
IF theSendMode = kAENoReply THEN { Client Doesn't want reply}
BEGIN
err := SendMessage(MsgHdrHdl(theAppleEvent.dataHandle), sendMode,
sendPriority, timeOutInTicks, idleProc, filterProc);
END
ELSE
BEGIN { Reply created from return message }
err := SendWithReply(theAppleEvent, tempReply, (theSendMode = kAEWaitReply),
sendPriority, sendMode, timeOutInTicks,
idleProc, filterProc);
END;
END;
IF tempReply.dataHandle <> NIL THEN
BEGIN
IF err = errAETimeout THEN
BEGIN
{ if it is a time out error, we set it up so that it can be handled in the future }
IF sendToSelf THEN { we don't set it earlier beacuse inWaiting flag will confuse
server }
MsgHdrHdl(tempReply.dataHandle)^^.inWaiting := TRUE { server is still using it }
ELSE
BEGIN
{ we add it to the waiting list, if that fails we returns the memory error and
the reply will be disposed in error handling below }
err := MustHaveGlobal(FALSE, aGlobalRef);
IF err = noErr THEN
BEGIN
{ this becomes the head of the wait list, and this points to the previous list head }
WITH aGlobalRef^^ DO
BEGIN
MsgHdrHdl(tempReply.dataHandle)^^.waitLink := waitReplyList;
waitReplyList := MsgHdrHdl(tempReply.dataHandle);
END;
err := errAETimeout; { since we destroy its value, we must put it back }
END;
END;
END
ELSE
BEGIN
MsgHdrHdl(tempReply.dataHandle)^^.inWaiting := FALSE; { we have got the reply or we
will throw it away }
END;
END;
999:
IF tempReply.dataHandle <> NIL THEN
BEGIN
IF err <> noErr THEN IF err <> errAETimeout THEN IgnoreOSErr(AE_DisposeDesc(tempReply));
END
ELSE
tempReply.descriptorType := typeNull;
{ check to make sure one was passed to us in case we have some C programmer }
IF @reply <> NIL THEN reply := tempReply;
AE_Send := err;
END;
{--------------------------------------------------------------------------------}
FUNCTION CheckAppleEvent(VAR theAppleEvent: AppleEvent): OSErr; { VAR is for efficiency only }
VAR
err: OSErr;
BEGIN
err := NoErr;
WITH theAppleEvent DO
BEGIN
IF dataHandle = NIL THEN
err := errAENotAEDesc
ELSE IF LONGINT(descriptorType) <> LONGINT(kCoreEventClass) THEN
err := paramErr;
END;
CheckAppleEvent := err;
END;
{--------------------------------------------------------------------------------}
{ Creates standard 'aevt''ansr' reply. Stuffs in errorcode, errorstring as passed. }
{ Stuffs refcon from origMsg. }
FUNCTION CreateDefaultReply(VAR origMsg: AppleEvent; { VAR is for efficiency only }
VAR theReply: AppleEvent { --> the reply }
): OSErr;
VAR
err: OSErr;
addrType: DescType;
addrLen: LONGINT;
transactionID: LONGINT;
aKey: AEKeyWord;
wantType: DescType;
actualSize: LONGINT;
BEGIN
{ the return address is in the header, we just locate its position and size }
WITH MsgHdrHdl(origMsg.dataHandle)^^ DO
BEGIN
IF LONGINT(msgAddrType) = LONGINT(typeTargetID) THEN
BEGIN { if it is target ID, we use session ID for efficiency }
addrType := typeSessionID;
addrLen := 4;
END
ELSE
BEGIN
addrType := msgAddrType;
addrLen := msgAddrSize;
END;
END;
{ if origMsg has transaction ID, we sent it back }
transactionID := kAnyTransactionID; { the default value }
aKey := keyTransactionIDAttr;
IgnoreOSErr(ReadData(MakeMeta(origMsg), 0, typeLongInteger, aKey, wantType, @transactionID,
SizeOf(transactionID), actualSize));
WITH MsgHdrHdl(origMsg.dataHandle)^^ DO
err := CreateBareMessage(addrLen, kCoreEventClass, kAEAnswer, ReturnID, transactionID,
theReply);
IF err = noErr THEN
BEGIN
{ we set up the return address }
BlockMove(Ptr(ord(origMsg.dataHandle^) + SizeOf(MsgHdr) - SizeOf(TargetID)),
Ptr(ord(theReply.dataHandle^) + SizeOf(MsgHdr) - SizeOf(TargetID)), addrLen);
WITH MsgHdrHdl(theReply.dataHandle)^^ DO
BEGIN
msgAddrSize := addrLen;
msgAddrType := addrType;
userRefcon := MsgHdrHdl(origMsg.dataHandle)^^.userRefcon;
END;
err := CheckMessage(MsgHdrHdl(theReply.dataHandle));
END;
CreateDefaultReply := err;
END;
{--------------------------------------------------------------------------------}
FUNCTION EppcFilter(VAR acceptRec: AcceptRecord; {vars used to compare to fields in incoming msg}
EPPCBuff: HighLevelEventMsgPtr;
VAR senderID: TargetID { var is for efficency only }
): Boolean;
{
This routine is passed as a procPtr to EPPC's GetSpecificHighLevelEvent.
It looks at the refcon to match up the reply with the original message.
Called by GetSpecificHighLevelEvent which is called by WaitGetReply.
Initially, field AcceptRecord must be SET to the sender's return ID and
transaction ID which is matched in the reply.
Field AcceptRecord.aBufferHdl must have been initialized as a Handle to a valid buffer.
On completion, the reply message (IF any) is accepted and is deposited into
AcceptRecord.aBufferHdl^^. AcceptRecord.aErr returns the error code.
Specification OF ReplyFilter must match the EPPC specification.
This must NOT be a nested PROCEDURE, gets called from the ToolBox
}
VAR
lenMsg: LONGINT;
processed: Boolean;
doDispatching: Boolean;
isAevt: Boolean;
senderDesc: AEDesc; { AEDesc for who sent this message }
msgRefcon: LONGINT;
transactionID: LONGINT;
switchBefore: LONGINT;
fromPSN: ProcessSerialNumber;
BEGIN {ReplyFilter}
processed := FALSE;
doDispatching := FALSE;
WITH acceptRec, EPPCBuff^ DO
BEGIN
filterErr := noErr;
IF userRefcon = msgReturnID THEN { does the refCon match? }
BEGIN
IF aBufferHdl = NIL THEN
BEGIN { we are checking for receipt }
IF LONGINT(theMsgEvent.message) = LONGINT(HighLevelEventMsgClass) THEN
IF LONGINT(theMsgEvent.where) = LONGINT(rtrnReceiptMsgID) THEN
BEGIN
{ pull it off the queue }
processed := TRUE; { this is the receipt }
IF theMsgEvent.modifiers <> msgWasFullyAccepted THEN
filterErr := errAEEventNotHandled; { the other side did not accept it }
PullOffTheQueue;
END;
END
ELSE
BEGIN { we are checking for reply }
IF LONGINT(theMsgEvent.message) = LONGINT(kCoreEventClass) THEN
IF LONGINT(theMsgEvent.where) = LONGINT(kAEAnswer) THEN
BEGIN
processed := TRUE;
{ get length from secret message header buried in the message }
lenMsg := msgLength;
IF lenMsg = 0 THEN lenMsg := SizeOf(AEMetaDesc);
SetHandleSize(Handle(aBufferHdl), SizeOf(MsgHdr) + lenMsg);
filterErr := MemError;
IF filterErr = noErr THEN
BEGIN
HLock(Handle(aBufferHdl));
WITH MsgHdrHdl(aBufferHdl)^^ DO
BEGIN
{ data is read into the buffer, targetID, refcon is also read directly into message header }
filterErr := AcceptHighLevelEvent(msgAddrTarget.asTargetID, msgRefcon,
Ptr(ord(Handle(aBufferHdl)^) +
SizeOf(MsgHdr)), lenMsg);
END;
IF filterErr = noErr THEN filterErr := CheckMessage(aBufferHdl);
HUnLock(Handle(aBufferHdl));
END;
END
ELSE IF LONGINT(theMsgEvent.where) = LONGINT(kCanSwitchIfInteract) THEN
BEGIN
IF PeekMetaParameter(EPPCBuff, keyBeforeTime, isAevt, switchBefore) THEN
IF isAevt THEN
IF GetProcessSerialNumberFromPortName(senderID.name, fromPSN) =
noErr THEN
IF (switchBefore - TickCount) > 1 THEN { and we met the deadline
}
IgnoreOSErr(SetFrontProcess(fromPSN)); { go ahead and do it }
PullOffTheQueue;
processed := TRUE;
filterErr := kNoneOfYourBusiness;
END
ELSE IF LONGINT(theMsgEvent.where) = LONGINT(kAEWaitLonger) THEN
BEGIN
PullOffTheQueue;
processed := TRUE;
filterErr := kAskResetTimer;
END;
IF BTst(theMsgEvent.modifiers, 0) THEN { part of the reply process }
doDispatching := TRUE;
END;
END;
{ extraFilter allows you to process AppleEvent which is not the reply }
{ the filter should return TRUE if you are willing to do so for this event }
IF NOT processed THEN
BEGIN
IF extraFilter <> NIL THEN
BEGIN
IF AE_CreateDesc(typeTargetID, @senderID, SizeOf(TargetID), senderDesc) =
noErr THEN
BEGIN
{ we are asking the application to filter it, in order this this we need to
scan to find out the tranaction id to pass it back to applicaiton }
IF NOT PeekMetaParameter(EPPCBuff, keyTransactionIDAttr, isAevt,
transactionID) THEN
transactionID := 0; { default if transaction ID cannot be found }
IF isAevt THEN { we only need to do it for AppleEvents }
doDispatching := DoExtraFilter(theMsgEvent, userRefcon, transactionID,
senderDesc, extraFilter);
IgnoreOSErr(AE_DisposeDesc(senderDesc));
END;
END;
IF doDispatching THEN IgnoreOSErr(AE_ProcessAppleEvent(theMsgEvent));
filterErr := kNoneOfYourBusiness;
END;
EppcFilter := processed OR doDispatching;
END;
END;
{--------------------------------------------------------------------------------}
{ from an EPPC buffer, we want to find out the parameter value of a particular keyword }
{ we use this instead of GetKeyPtr because it has not been converted into an AppleEvent }
FUNCTION PeekMetaParameter(EPPCBuff: HighLevelEventMsgPtr; { the EPPC msg buffer }
theAttribute: AEKeyWord; { look for this key word }
VAR isAevt: Boolean; { does it look like an AppleEvent? }
VAR theValue: LONGINT { value of the keyword attribute }
): Boolean;
VAR
aCommonPtr: CommonHeaderPointer;
dataEnd: LONGINT;
BEGIN
PeekMetaParameter := FALSE;
WITH EPPCBuff^ DO
BEGIN
IF msgLength >= 12 THEN
BEGIN { must be at least this long to be an non empty AppleEvent }
{ we first point to beginning of buffer }
aCommonPtr := CommonHeaderPointer(ord(EPPCBuff) + HighLevelEventMsgHeaderLength);
{ check for AppleEvent header }
WITH AEMetaPointer(aCommonPtr)^ DO
isAevt := (LONGINT(aevtMarker) = LONGINT(kCoreEventClass)) AND (version =
kVersionOne);
IF isAevt THEN
BEGIN
dataEnd := ord(aCommonPtr) + msgLength;
aCommonPtr := CommonHeaderPointer(ord(aCommonPtr) + 8); { skip the header }
WHILE ord(aCommonPtr) < dataEnd DO
WITH aCommonPtr^ DO
BEGIN
IF LONGINT(theKeyword) = LONGINT(aeEndOfMetaDataKeyword) THEN LEAVE; {
cannot find it in meta parameter }
IF LONGINT(theKeyword) = LONGINT(theAttribute) THEN
BEGIN { we found it }
IF LONGINT(theType) = LONGINT(typeLongInteger) THEN
BEGIN { must be a LONGINT for this routine }
theValue := LONGINTPtr(ord(aCommonPtr) + SizeOf(commonHeader))^;
PeekMetaParameter := TRUE;
END;
LEAVE;
END;
{ aCommonPtr := CommonHeaderPointer(ord(aCommonPtr) + RoundUp(theLength +
SizeOf(CommonHeader))); }
aCommonPtr := CommonHeaderPointer(ord(aCommonPtr) + BAnd(theLength +
SizeOf(CommonHeader) + RoundUpValue,
RoundUpMask));
END;
END;
END
ELSE IF msgLength = 0 THEN isAevt := TRUE; { an empty message }
END;
END;
{--------------------------------------------------------------------------------}
{ take an HLE off the queue by accepting it }
PROCEDURE PullOffTheQueue;
VAR
sender: TargetID;
msgRefcon: LONGINT;
msgLen: LONGINT;
BEGIN
msgLen := 0;
IgnoreOSErr(AcceptHighLevelEvent(sender, msgRefcon, NIL, msgLen));
END;
{--------------------------------------------------------------------------------}
{ Used internally to send message buffers. Called from a routine inside AESend }
{ Uses EPPC to send a message and wait for a receipt if required. }
FUNCTION SendMessage(theMsg: MsgHdrHdl;
sendMode: LONGINT;
sendPriority: integer; { AEHighPriority, AENormalPriority }
timeOut: LONGINT; { sender's timeout in ticks }
waitingHook: ProcPtr; {Routine to call to spin the cursor}
extraHandlingFilter: ProcPtr { extra event processing filter }
): OSErr;
LABEL 999;
VAR
theEvent: EventRecord;
address: EppcAddress;
acceptRec: AcceptRecord;
done: Boolean;
gotEvent: Boolean;
withReceipt: Boolean;
withReconnect: Boolean;
msgSize: LONGINT;
err: OSErr;
theRefCon: LONGINT;
headerSize: LONGINT;
coercedTarget: AEDesc; { if not a known address mode, then try to coerce it to one in here }
BEGIN
coercedTarget.dataHandle := NIL;
HLock(Handle(theMsg));
WITH theMsg^^ DO AddrTypeToPostingOptions(LONGINT(msgAddrType), @msgAddrTarget, address);
{ if address mode is not known, try to coerce to something that eppc can understand }
IF address.postingOptions = 0 THEN
BEGIN
{ try to coerce to a type that eppc can understand }
IF TryEppcFail(theMsg, typeProcessSerialNumber, coercedTarget) THEN
IF TryEppcFail(theMsg, typeTargetID, coercedTarget) THEN
IF TryEppcFail(theMsg, typeSessionID, coercedTarget) THEN
IF TryEppcFail(theMsg, typeApplSignature, coercedTarget) THEN
BEGIN
err := errAEUnknownAddressType;
GOTO 999;
END;
WITH coercedTarget DO
BEGIN
HLock(dataHandle);
AddrTypeToPostingOptions(LONGINT(coercedTarget.descriptorType), dataHandle^,
address);
END;
END;
WITH theMsg^^ DO
BEGIN
theEvent.message := LONGINT(thisAEEventClass);
LONGINT(theEvent.where) := LONGINT(thisAEEventID);
IF BTst(sendMode, kBitPartOfReply) THEN
theEvent.modifiers := 1
ELSE
theEvent.modifiers := 0;
theRefCon := ReturnID;
END;
withReceipt := BTst(sendMode, kBitWantReceipt);
withReconnect := NOT BTst(sendMode, kBitDontReconnect);
IF withReceipt THEN BSet(address.postingOptions, kBitWantReceipt);
IF sendPriority = kAEHighPriority THEN BSet(address.postingOptions, kBitAttnMsg);
{Send the message. Include the metadata but not the message header}
{Point ePPC past the msgHdr so add size to it. Pass size as msg - msgHeader}
headerSize := SizeOf(MsgHdr) - SizeOf(TargetID) + theMsg^^.msgAddrSize;
msgSize := GetHandleSize(Handle(theMsg)) - headerSize;
IF msgSize <= SizeOf(AEMetaDesc) THEN msgSize := 0; { There is no message buffer, so it is
an empty message }
done := FALSE;
REPEAT
WITH address DO
err := PostHighLevelEvent(theEvent, sendToAddr, theRefCon, Ptr(ord(theMsg^) +
headerSize), msgSize, postingOptions);
IF withReconnect AND (err = sessClosedErr) THEN
withReconnect := FALSE { if withReconnect is TRUE, we are willing to do 1 more time
}
ELSE
done := TRUE; { otherwise that is it }
UNTIL done;
{ if the temporary target was from coercion, we no longer need it }
WITH coercedTarget DO
IF dataHandle <> NIL THEN { avoid trap call if possible }
DisposHandle(dataHandle);
IF withReceipt THEN
IF (err = noErr) THEN
BEGIN { if need to wait for the receipt }
WITH acceptRec DO
BEGIN
extraFilter := extraHandlingFilter;
msgReturnID := theRefCon; { make a record for the reciept filter }
aBufferHdl := NIL; { to indicate this is for receipt }
END;
err := GeneralWait(timeOut, waitingHook, @EppcFilter, @acceptRec);
END;
999:
HUnLock(Handle(theMsg));
SendMessage := err;
END;
{--------------------------------------------------------------------------------}
{ Call SendMessage. Create Reply buffer. }
{ Call Do EventAvail and GetSpecificHighLevelEvent until got msg or timeout }
FUNCTION SendWithReply(VAR msg: AppleEvent; { VAR is for efficiency only }
VAR reply: AppleEvent; {Uninitialized, we create it(pass to createmsg)}
isWaitReply: Boolean; { Queue or Wait for a reply after sending }
sendPriority: integer; { AEHighPriority, AENormalPriority }
sendMode: LONGINT;
timeOut: LONGINT; {sender's timeout in ticks}
waitingHook: ProcPtr; {Routine to call to spin the cursor}
extraHandlingFilter: ProcPtr { extra event processing filter }
): OSErr;
VAR
err: OSErr;
acceptRec: AcceptRecord; {Contains msgRefcon,the replyBuffer,aErr}
typeCode: DescType;
actualSize: LONGINT;
BEGIN {SendWaitReply}
err := noErr;
CalculateTimeout(timeOut); { convert default to actual value }
IF timeOut <> 0 THEN
BEGIN { we put out a time out attriubte to inform the server }
err := WriteData(MakeMeta(msg), keyTimeoutAttr, typeLongInteger, @timeOut, 4, 0, 1);{
send time out over }
END
ELSE { otherwise 'repq' is used to indicate a reply is needed }
err := WriteData(MakeMeta(msg), kReplyRequestedKeyword, typeTrue, NIL, 0, 0, 1); {add
reply requested as meta}
IF err = noErr THEN
{ now we send out the message }
err := SendMessage(MsgHdrHdl(msg.dataHandle), sendMode, sendPriority,
timeOut, waitingHook, extraHandlingFilter);
IF err = noErr THEN
IF isWaitReply THEN
BEGIN { we are going to wait for the reply }
{ we set up buffer and accept record for the reply filter }
WITH MsgHdrHdl(msg.dataHandle)^^ DO
err := CreateBareMessage(SizeOf(TargetID), kCoreEventClass, kAEAnswer, ReturnID,
kAnyTransactionID, reply);
IF err = noErr THEN
BEGIN
WITH MsgHdrHdl(reply.dataHandle)^^ DO
BEGIN
msgAddrType := typeTargetID;
msgAddrSize := SizeOf(TargetID);
userRefcon := MsgHdrHdl(msg.dataHandle)^^.userRefcon;
inWaiting := TRUE;
WITH acceptRec DO
BEGIN
extraFilter := extraHandlingFilter;
aBufferHdl := MsgHdrHdl(reply.dataHandle); { This sets up the reply!!!!}
msgReturnID := ReturnID
END;
END;
err := GeneralWait(timeOut, waitingHook, @EppcFilter, @acceptRec);
END;
END;
SendWithReply := err;
END;
{--------------------------------------------------------------------------------}
FUNCTION TryEppcFail(theMsg: MsgHdrHdl;
toType: DescType;
VAR coercedTarget: AEDesc): Boolean;
{ here we are trying to coerce it something eppc can understand,
doing it this way we have all the overhead of coercion
in future version we may try to find corecion routine directly
in stead of using AE_CoercePtr }
BEGIN
WITH theMsg^^ DO
TryEppcFail := (AE_CoercePtr(msgAddrType, @msgAddrTarget, msgAddrSize, toType,
coercedTarget) <> noErr);
END;
{--------------------------------------------------------------------------------}