sys7.1-doc-wip/Toolbox/AppleEventMgr/AEUtil.inc1.p

{
	File:		AEUtil.inc1.p

	Contains:	xxx put contents here xxx

	Written by:	xxx put writers here xxx

	Copyright:	© 1990 by Apple Computer, Inc., all rights reserved.

    This file is used in these builds: BigBang

	Change History (most recent first):

		 <5>	  2/5/91	Lai		BM,#81596: Also for bug jfr101 on whiteboard. In AECreateDesc
									take care of case when it is a reco/list, code is moved from
									AECoercion.inc1.p.
		 <4>	 1/17/91	Lai		Return the correct error when creating a null desc
		 <3>	 1/11/91	Lai		AECreateDesc now returns null desc only if typeCode is 'null'.
		 <2>	12/21/90	Lai		TryBothProc not returning the error causing AEDisposeDesc not to
									dispose the handle.
		 <1>	12/13/90	Lai		first checked in

	To Do:
}

{--------------------------------------------------------------------------------}

FUNCTION CallOneParamProc(theDesc: AEDesc;
                          callproc: ProcPtr): OSErr;
{ inline is equivalent to : movea.l (a7)+,a0; jsr (a0) }
    INLINE $205F, $4E90;

{--------------------------------------------------------------------------------}

FUNCTION CallWaitHook(VAR theEvent: EventRecord;
                      VAR sleep: LONGINT;
                      VAR mouseRgn: RgnHandle;
                      theProc: ProcPtr): Boolean;
{ inline is equivalent to : movea.l (a7)+,a0; jsr (a0) }
    INLINE $205F, $4E90;

{--------------------------------------------------------------------------------}

FUNCTION AE_CreateList(factoringPtr: Ptr;
                       factoredSize: LONGINT;
                       isRecord: boolean;
                       VAR resultList: AEDesc): OSErr;
    EXTERNAL;

{--------------------------------------------------------------------------------}

{ for now it is just a PtrToHand, if we ever to a #XXX descriptor type, we need
    to change this }

FUNCTION AE_CreateDesc(typeCode: DescType;
                       dataPtr: Ptr;
                       dataSize: LONGINT;
                       VAR result: AEDesc): OSErr;
	VAR
		err:	OSErr;
    BEGIN
		err := NoErr;
        WITH result DO
            BEGIN
            descriptorType := typeCode;
            dataHandle := NIL;
			IF (LONGINT(typeCode) = LONGINT(typeAEList)) OR (LONGINT(typeCode) = LONGINT(typeAERecord)) THEN
				BEGIN
				err := PtrToHand(Ptr(ord(dataPtr) - SizeOf(ListClassRec)), dataHandle,
								 dataSize + SizeOf(ListClassRec));
				IF err = NoErr THEN
					BEGIN
					WITH ListHdrHdl(dataHandle)^^ DO
						BEGIN
						WITH listClassHeader DO
							BEGIN
							hintIndex := 0;
							paramBegin := BAnd(sizeOfPrefix + SizeOf(ListHdr) + RoundUpValue,
											   RoundUpMask);
							metaCountOrObjType := LONGINT(typeCode);
							END;
						END;
					END;
				END
            ELSE IF LONGINT(typeCode) <> LONGINT(typeNull) THEN 
				err := PtrToHand(dataPtr, dataHandle, dataSize);
            IF dataHandle = NIL THEN descriptorType := typeNull;
            END;
		AE_CreateDesc := err;
    END;

{--------------------------------------------------------------------------------}

{ duplicate a desc, again take special care for AppleEvent }

FUNCTION AE_DuplicateDesc(VAR theAEDesc: AEDesc; { VAR is for efficiency only }
                          VAR result: AEDesc): OSErr;

    VAR
        err: OSErr;

    BEGIN
        result := theAEDesc;
        WITH result DO
            BEGIN
			IF dataHandle = NIL THEN { just copy it is good enough }
				err := noErr
			ELSE
				BEGIN
				err := HandToHand(dataHandle);
				IF (err = noErr) THEN
					BEGIN
					IF (LONGINT(descriptorType) = LONGINT(kCoreEventClass)) THEN
						WITH MsgHdrHdl(dataHandle)^^ DO
							BEGIN
							inUse := FALSE;
							accessMask := 0;
							END;
					END
				ELSE
					NukeIt(result);
				END;
            END;
        AE_DuplicateDesc := err;
    END;

{--------------------------------------------------------------------------------}

{ get the interact level allowed when used as a server }
{ it is in the global, just get it from there }

FUNCTION AE_GetInteractionAllowed(VAR level: AEInteractAllowed): OSErr;

    VAR
        aGlobalRef: GlobalRecHandle;

    BEGIN
        AE_GetInteractionAllowed := noErr;
        aGlobalRef := GetGlobalRef;
        IF aGlobalRef <> NIL THEN
            level := aGlobalRef^^.interactAllowance
        ELSE { otherwise it is the default }
            level := kAEInteractWithLocal;
    END;

{--------------------------------------------------------------------------------}

{ return the AppleEvent being processed, just fetch the value from the global }

FUNCTION AE_GetTheCurrentEvent(VAR theAppleEvent: AppleEvent): OSErr;

    VAR
        aGlobalRef: GlobalRecHandle;

    BEGIN
        WITH theAppleEvent DO
            BEGIN
            descriptorType := kCoreEventClass;
            dataHandle := NIL;
			aGlobalRef := GetGlobalRef;
			IF aGlobalRef <> NIL THEN 
				dataHandle := Handle(aGlobalRef^^.currentMsg);
			IF dataHandle = NIL THEN
            	descriptorType := typeNull;
            END;
        AE_GetTheCurrentEvent := noErr;
    END;

{--------------------------------------------------------------------------------}

{ set the interact level allowed when used as a server }
{ it is in the global, just put it there }

FUNCTION AE_SetInteractionAllowed(level: AEInteractAllowed): OSErr;

    VAR
        aGlobalRef: GlobalRecHandle;

    BEGIN
        AE_SetInteractionAllowed := MustHaveGlobal(FALSE, aGlobalRef);
        IF aGlobalRef <> NIL THEN aGlobalRef^^.interactAllowance := level;
    END;

{--------------------------------------------------------------------------------}
{ make the current event, if there is a current event, we push it up the stack
    chain so that we can return to it when we are done with it }

FUNCTION AE_SetTheCurrentEvent(VAR theAppleEvent: AppleEvent): OSErr; { VAR is for efficiency only }

    VAR
        aGlobalRef: GlobalRecHandle;
        thisMsg: MsgHdrHdl;

    BEGIN
        AE_SetTheCurrentEvent := noErr;
        aGlobalRef := GetGlobalRef;
        thisMsg := MsgHdrHdl(theAppleEvent.dataHandle);
        IF (aGlobalRef <> NIL) AND (thisMsg <> NIL) THEN
            WITH aGlobalRef^^ DO
                IF currentMsg <> thisMsg THEN
                    BEGIN { from now until we return from dispatcher, this is the current message }
                    thisMsg^^.prevMsg := currentMsg;
                    currentMsg := thisMsg;
                    END;
    END;

{--------------------------------------------------------------------------------}

FUNCTION AE_SuspendTheCurrentEvent(VAR theAppleEvent: AppleEvent): OSErr; { VAR is for efficiency
                                                                           only }

    VAR
        aGlobalRef: GlobalRecHandle;

    BEGIN
        AE_SuspendTheCurrentEvent := noErr;
        aGlobalRef := GetGlobalRef;

        IF aGlobalRef <> NIL THEN
            WITH aGlobalRef^^ DO
                BEGIN
                IF currentMsg = MsgHdrHdl(theAppleEvent.dataHandle) THEN
                    currentMsg := currentMsg^^.prevMsg;
                END;

    END;

{--------------------------------------------------------------------------------}

{ calculate the timeout value, for now, default is just a constant }

PROCEDURE CalculateTimeOut(VAR timeOut: longint);

    BEGIN
        IF timeOut = kAEDefaultTimeout THEN
            timeOut := standardTimeOut
        ELSE IF timeOut = kNoTimeOut THEN
            timeOut := MaxLONGINT
        ELSE IF timeOut < 0 THEN timeOut := 0;
    END;

{--------------------------------------------------------------------------------}

{ for creating a list or a record }

FUNCTION CreateList(factoringPtr: Ptr;
                    factoredSize: LONGINT;
                    isRecord: boolean;
                    VAR resultList: AEDesc;
                    objectType: DescType): OSErr;
{ factoringPtr is ptr to buffer containing header of list }
{ factoredSize is size of that buffer }
{ dataPtr does not include the header }

    VAR
        aHandle: Handle;
        err: OSErr;

    BEGIN
        aHandle := NIL;
        IF factoringPtr = NIL THEN factoredSize := 0;
        IF (factoredSize = 0) OR (factoredSize = 4) OR (factoredSize >= 8) THEN
            BEGIN
            aHandle := NewHandleClear(SizeOf(ListHdr) + BAnd(factoredSize + RoundUpValue,
                                                             roundUpMask));
            IF aHandle <> NIL THEN
                BEGIN
                WITH ListHdrHdl(aHandle)^^ DO
                    BEGIN
                    WITH listClassHeader DO
                        BEGIN
                        paramBegin := SizeOf(ListHdr) + BAnd(factoredSize + RoundUpValue,
                                                             roundUpMask);
                        WITH resultList DO
                            BEGIN
                            IF isRecord THEN
                                BEGIN
                                descriptorType := typeAERecord;
                                IF LONGINT(objectType) = 0 THEN
                                    metaCountOrObjType := LONGINT(descriptorType)
                                ELSE
                                    metaCountOrObjType := LONGINT(objectType);
                                END
                            ELSE
                                BEGIN
                                descriptorType := typeAEList;
                                metaCountOrObjType := LONGINT(descriptorType);
                                END;
                            END;
                        END;
                    IF factoredSize <> 0 THEN { put in the factoring data }
                        BEGIN
                        sizeOfPrefix := factoredSize;
                        BlockMove(factoringPtr, Ptr(ord(aHandle^) + SizeOf(ListHdr)), factoredSize);
                        END;
                    END;
                err := noErr;
                END
            ELSE
                err := MemError;
            END
        ELSE
            BEGIN
            { only legal values are 0=unfactored, 4=homogeneous, 8=homogeneous+fixedSized or above }
            err := paramErr;
            END;
        WITH resultList DO
            BEGIN
            dataHandle := aHandle;
            IF err <> noErr THEN descriptorType := typeNull;
            END;
        CreateList := err;
    END;

{--------------------------------------------------------------------------------}

{ given a message, determine its source }

PROCEDURE EventSource(theMsgHdl: MsgHdrHdl;
                      VAR theAEEventSource: AEEventSource;
                      VAR fromPSN: ProcessSerialNumber);

    VAR
        myPSN: ProcessSerialNumber;
        sameOne: boolean;

    BEGIN
        theAEEventSource := kAEUnknownSource;
        IF theMsgHdl <> NIL THEN
            WITH theMsgHdl^^ DO
                BEGIN
                IF LONGINT(msgAddrType) = LONGINT(typeTargetID) THEN { we know it is not send to
                                                                      self }
                    BEGIN
                    IF msgAddrTarget.asTargetID.location.locationKindSelector = ppcNoLocation THEN
                        BEGIN { process is in the same machine }
						WITH myPSN DO
							BEGIN
							highLongOfPSN := 0;
							lowLongOfPSN := kCurrentProcess;
							END;
						sameOne := FALSE;
                        IF GetProcessSerialNumberFromPortName(msgAddrTarget.asTargetID.name, fromPSN) =
                           noErr THEN
                            IgnoreOSErr(SameProcess(fromPSN, myPSN, sameOne));
                        IF sameOne THEN
                            theAEEventSource := kAESameProcess
                        ELSE
                            theAEEventSource := kAELocalProcess;
                        END
                    ELSE
                        theAEEventSource := kAERemoteProcess;
                    END
                ELSE IF LONGINT(msgAddrType) = LONGINT(typeProcessSerialNumber) THEN
                    BEGIN
					WITH msgAddrTarget.asPSN DO
						IF lowLongOfPSN = kCurrentProcess THEN
							IF highLongOfPSN = 0 THEN
                    			theAEEventSource := kAEDirectCall;
                    END;
                END;
    END;

{--------------------------------------------------------------------------------}

{ this is the common routine for waiting until timeout and pass back some event to application }
{ this routine is shared between the case where you are filtering high level event, and the case
    where you are waiting to come to the front during AEInteractWith User }
{ if this routine is called with a filterProc, it is considered to be the former case, if filter
    proc is nil, it is the latter case }

FUNCTION GeneralWait(VAR timeOut: LONGINT;
                     waitingHook: ProcPtr;
                     filterProc: ProcPtr;
                     filterInfo: Ptr): OSErr;

    VAR
        err: OSErr;
        done: Boolean;
        passBackEvent: EventRecord;
        sleep: LONGINT;
        mouseRgn: RgnHandle;
        expiredTime: LONGINT;
        waitMask: integer;
        myPSN: ProcessSerialNumber; { the PSN of this process }
        frontPSN: ProcessSerialNumber; { the PSN of the front process }
        { a evil nested procedure }

    FUNCTION CheckWaitHook: Boolean;

        BEGIN
            CheckWaitHook := FALSE;
            IF waitingHook <> NIL THEN { do some idle time processing }
                BEGIN
                waitMask := BXOR(waitMask, updateMask); { toggle it }
                IF CallWaitHook(passBackEvent, sleep, mouseRgn, waitingHook) THEN { user cancel }
                    BEGIN
                    err := errAEWaitCanceled;
                    CheckWaitHook := TRUE;
                    END;
                END;
        END;

    BEGIN
        done := FALSE;
        err := noErr;
        CalculateTimeOut(timeOut);
        expiredTime := TickCount + timeOut;
        waitMask := 0; { nothing to look at }
 { these are default value in case there is no wait hook and they did not bother to return a value }
        sleep := 1; { just yield }
        mouseRgn := NIL; { no mouse region }
        IF waitingHook <> NIL THEN
            BEGIN
        { we can pass these event back to the application, we do not set update mask here even
            we want it because we will toggle the update mask bit every time just in case
            the update event was never processed by the idle proc and we can never get to the
            high level event }
            waitMask := activMask + app4Mask;
            { Fake a null event and pass it to idle proc for the first time to get mouseRgn }
            IF OSEventAvail(0, passBackEvent) THEN; { generate a dummy null event }
            done := CheckWaitHook;
            END;

        { now we loop until reply received, timeout or user cancel }

        WHILE NOT done DO
            BEGIN { until got reply or timeout or error}
            IF filterProc <> NIL THEN
                BEGIN { we want to do a filter on high level event }
                IF GetSpecificHighLevelEvent(filterProc, filterInfo, err) THEN
                    WITH AcceptRecordPtr(filterInfo)^ DO
                        BEGIN
                        IF filterErr = kAskResetTimer THEN
                            expiredTime := TickCount + timeOut { it is 'aevt' 'wait' }
                        ELSE IF filterErr <> kNoneOfYourBusiness THEN 
                            BEGIN
                            done := TRUE;
                            IF err = noErr THEN { the error is either err or in the accept record }
                                err := filterErr;
                            END;
                        END;
                END
            ELSE { if we are not checking on high level event, then we are checking for come to
                  front }
                BEGIN
                IgnoreOSErr(GetCurrentProcess(myPSN));
                IgnoreOSErr(GetFrontProcess(frontPSN));
                IgnoreOSErr(SameProcess(myPSN, frontPSN, done));
                END;
            IF NOT done THEN
                BEGIN
                timeOut := expiredTime - TickCount; { we keep track of remaining time }
            { note that this line should be timeOut > 0 and not expiredTime > TickCount,
                because it would work even if expiredTime is negative }
                IF timeOut > 0 THEN { we are still waiting }
                    BEGIN
                    IF sleep > timeOut THEN sleep := timeOut;
                    IF WaitNextEvent(waitMask, passBackEvent, sleep, mouseRgn) THEN; { so that we
                        can yield if necessary }
                    IF CheckWaitHook THEN LEAVE;
                    END
                ELSE { otherwise it is time out }
                    BEGIN
                    err := errAETimeout;
                    LEAVE;
                    END;
                END;
            END;
    { we return the remaining time out because wait for reciept may use up some time and then
        timeOut left for wait reply would have to be reduced }
        IF timeOut < 0 THEN timeOut := 0;
        GeneralWait := err;
    END;

{--------------------------------------------------------------------------------}

FUNCTION MakeMeta(VAR theAevt: AppleEvent): AppleEvent; { VAR is for efficiency only }

    BEGIN
        MakeMeta.dataHandle := theAevt.dataHandle;
        MakeMeta.descriptorType := typeMeta;
    END;

{--------------------------------------------------------------------------------}

{ get a application/system global, initialize if necessary }

FUNCTION MustHaveGlobal(isSysHandler: Boolean;
                        VAR aGlobalRef: GlobalRecHandle): OSErr;

    TYPE
        GlobalRecHandlePtr = ^GlobalRecHandle;

    VAR
        err: OSErr;
        aGlobalHandle: GlobalRecHandle;
        aGlobalRecHandlePtr: GlobalRecHandlePtr;

    BEGIN
        err := noErr;
        IF isSysHandler THEN
            aGlobalRecHandlePtr := GlobalRecHandlePtr(LongIntPtr(ExpandMem)^ + kAESysGlobalOffset)
        ELSE
            aGlobalRecHandlePtr := GlobalRecHandlePtr(LongIntPtr(ExpandMem)^ + kAEAppGlobalOffset);
        aGlobalRef := aGlobalRecHandlePtr^;
        IF aGlobalRef = NIL THEN
            BEGIN
            IF isSysHandler THEN
                aGlobalHandle := GlobalRecHandle(NewHandleSysClear(SizeOf(SysGlobalRec))) { create a
                                                     new one }
            ELSE
                aGlobalHandle := GlobalRecHandle(NewHandleClear(SizeOf(GlobalRec))); { create a new
                one }
            IF aGlobalHandle = NIL THEN
                err := MemError
            ELSE
                BEGIN
                IF NOT isSysHandler THEN
                    WITH aGlobalHandle^^ DO
						BEGIN { these field only available for the application global }
						ReturnIDCounter := $10000 + LoWrd(TickCount); { because high word should
																	   not be zero }
						interactAllowance := kAEInteractWithLocal;
						END;
				aGlobalRecHandlePtr^ := aGlobalHandle;
				aGlobalRef := aGlobalHandle;
                END;
            END;
        MustHaveGlobal := err;
    END;

{--------------------------------------------------------------------------------}

PROCEDURE NukeIt(VAR theAEDesc: AEDesc);

    BEGIN
        WITH theAEDesc DO
            BEGIN
            descriptorType := typeNull;
            dataHandle := NIL;
            END;
    END;

{--------------------------------------------------------------------------------}

{ Wait list is the list of message that has a reply handle but no content }
{ this proceudre removes a message from the wait list either because the content
    has arrived or the message is disposed }
{ the wait list is a linked list of message, if the message is found in the linked list
    remove it from the linked list }

PROCEDURE OffWaitList(aHandle: MsgHdrHdl);

    VAR
        aGlobalRef: GlobalRecHandle;
        curMsgHdl: MsgHdrHdl;
        nextMsgHdl: MsgHdrHdl;

    BEGIN
        aGlobalRef := GetGlobalRef;
        IF aGlobalRef <> NIL THEN
            WITH aGlobalRef^^ DO
                BEGIN
                curMsgHdl := waitReplyList;
                IF aHandle = curMsgHdl THEN
                { if it is the head of list, then 2nd one becomes head of list }
                    waitReplyList := curMsgHdl^^.waitLink
                ELSE
                    BEGIN
                    WHILE curMsgHdl <> NIL DO
                        BEGIN
                        nextMsgHdl := curMsgHdl^^.waitLink; { next item in the link list }
                        IF nextMsgHdl = aHandle THEN
                            BEGIN { next item is the one to be removed }
                            { make wait link point to item after the next one }
                            curMsgHdl^^.waitLink := nextMsgHdl^^.waitLink;
                            LEAVE;
                            END
                        ELSE
                            curMsgHdl := nextMsgHdl; { look for the next one }
                        END;
                    END;
                END;
    END;

{--------------------------------------------------------------------------------}

FUNCTION TryBothProc(VAR theDesc: AEDesc;
                     procOffset: LONGINT): OSErr;

    VAR
        err: OSErr;

    FUNCTION TryOneProc(aGlobalRef: GlobalRecHandle): OSErr;

        VAR
            aProcPtr: ProcPtr;

        BEGIN
            TryOneProc := errAEEventNotHandled;
            IF aGlobalRef <> NIL THEN
                BEGIN
                aProcPtr := ProcPtr(LONGINTPtr(ord(aGlobalRef^) + procOffset)^);
                IF aProcPtr <> NIL THEN TryOneProc := CallOneParamProc(theDesc, aProcPtr);
                END;
        END;

    BEGIN
        err := TryOneProc(GetGlobalRef);
        IF err = errAEEventNotHandled THEN err := TryOneProc(GetSysGlobal); { not there, then try
            the system wide one }
		TryBothProc := err;
    END;

{--------------------------------------------------------------------------------}