Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Frameworks/DropShell Pascal/DSUtils.p

Text File | 1994-05-27 | 9.6 KB | 343 lines | [TEXT/MPS ]

{******************************************************************************
**
**  Project Name:    DropShell
**     File Name:    DSUtils.p
**
**   Description:    Utility routines that may be useful to DropBoxes
**
*******************************************************************************
**                       A U T H O R   I D E N T I T Y
*******************************************************************************
**
**    Initials    Name
**    --------    -----------------------------------------------
**    LDR            Leonard Rosenthol
**
*******************************************************************************
**                      R E V I S I O N   H I S T O R Y
*******************************************************************************
**
**      Date        Time    Author    Description
**    --------    -----    ------    ---------------------------------------------
**    12/09/91            LDR        Added the Apple event routines
**    11/24/91            LDR        Original Version
**
******************************************************************************}
UNIT DSUtils;
INTERFACE

{$IFC THINK_Pascal}
    USES
        Aliases, AppleEvents, PPCToolbox, Processes, Script, DSGlobals;    {just the DropShell files}
{$ELSEC}
    USES
    { First load standard interface files}
        MemTypes, QuickDraw,

    { Now include the stuff from OSIntf }
        OSIntf,

    { Now Include the stuff from ToolIntf.p }
        ToolIntf, Packages, GestaltEqu,

    { Then any OTHER Toolbox interfaces... }
        Files, Aliases, AppleEvents, PPCToolbox, Processes,

    { And finally any files from DropShell }
        DSGlobals;
{$ENDC THINK_Pascal}

{---------------------}
{Interface Definitions}
{---------------------}

    PROCEDURE CenterAlert (theID: integer);
    PROCEDURE ErrorAlert (stringListID, stringIndexID, errorID: integer);

    PROCEDURE GetAppName (VAR appName: Str255);
    PROCEDURE GetAppFSSpec (VAR appSpec: FSSpec);

    FUNCTION GetTargetFromSelf (VAR targetDesc: AEAddressDesc): OSErr;
    FUNCTION GetTargetFromSignature (processSig: OSType; VAR targetDesc: AEAddressDesc): OSErr;
    FUNCTION GetTargetFromBrowser (promptStr: Str255; VAR targetDesc: AEAddressDesc): OSErr;

    PROCEDURE SendODOCToSelf (theFileSpec: FSSpec);
    PROCEDURE SendQuitToSelf;

IMPLEMENTATION
{$S Main}

    {
        This routine is used to properly center an Alert before showing.

        It is per Human Interface specs by putting it in the top 1/3 of screen.
        NOTE: This same technique can be used with DLOG resources as well.
    }
    PROCEDURE CenterAlert (theID: integer);
        VAR
            theX, theY: INTEGER;
            theAlertHandle: AlertTHndl;
    BEGIN
        theAlertHandle := AlertTHndl(GetResource('ALRT', theID));
        IF theAlertHandle <> NIL THEN
        BEGIN
            HLock(Handle(theAlertHandle));
            WITH theAlertHandle^^ DO
            BEGIN
                WITH qd.screenBits DO
                BEGIN
                    theX := ((bounds.right - bounds.left) - (boundsRect.right - boundsRect.left)) DIV 2;
                    theY := ((bounds.bottom - bounds.top) + GetMBarHeight - (boundsRect.bottom - boundsRect.top)) DIV 2;
                    theY := theY - ((bounds.bottom - bounds.top) DIV 4);    {this moves it up for better viewing!}
                END;
                OffsetRect(boundsRect, theX - boundsRect.left, theY - boundsRect.top);
            END;
        END;
        SetCursor(qd.arrow);    {if you use this routine in a code resource, change this!}
    END;

    {
        This routine is just a quick & dirty error reporter
    }
    PROCEDURE ErrorAlert (stringListID, stringIndexID, errorID: integer);
        CONST
            alertID = 200;
        VAR
            item: integer;
            param, errorStr: Str255;
    BEGIN
        NumToString(errorID, errorStr);
        GetIndString(param, stringListID, stringIndexID);
        ParamText(param, errorStr, '', '');
        CenterAlert(alertID);
        item := Alert(alertID, NIL);
    END;

{*** These routines use the Process Manager to give you information about yourself ***}

    PROCEDURE GetAppName (VAR appName: Str255);
        VAR
            err: OSErr;
            info: ProcessInfoRec;
            curPSN: ProcessSerialNumber;
    BEGIN
        err := GetCurrentProcess(curPSN);

        WITH info DO
        BEGIN
            processInfoLength := sizeof(ProcessInfoRec);    {ALWAYS USE sizeof!}
            processName := @appName;                        {so it returned somewhere}
            processAppSpec := NIL;                            {I don't care!}
        END;
        err := GetProcessInformation(curPSN, info);
    END;

    PROCEDURE GetAppFSSpec (VAR appSpec: FSSpec);
        VAR
            err: OSErr;
            info: ProcessInfoRec;
            appName: Str255;
            curPSN: ProcessSerialNumber;
    BEGIN
        err := GetCurrentProcess(curPSN);

        WITH info DO
        BEGIN
            processInfoLength := sizeof(ProcessInfoRec);    {ALWAYS USE sizeof!}
            processName := @appName;                        {so it returned somewhere}
            processAppSpec := @appSpec;                        {and here's where the spec goes}
        END;
        err := GetProcessInformation(curPSN, info);
    END;


{ ••• Apple event routines begin here ••• }

{
    This routine will create a targetDesc for sending to self.

    We take IM VI's advice and use the typePSN form with
    kCurrentProcess as the targetPSN.
}
    FUNCTION GetTargetFromSelf (VAR targetDesc: AEAddressDesc): OSErr;
        VAR
            err: OSErr;
            psn: ProcessSerialNumber;
    BEGIN
        WITH psn DO
        BEGIN
            highLongOfPSN := 0;
            lowLongOfPSN := kCurrentProcess;
        END;
        err := AECreateDesc(typeProcessSerialNumber, @psn, sizeof(ProcessSerialNumber), targetDesc);
        GetTargetFromSelf := err;
    END;

{This routine will create a targetDesc using the apps signature}
    FUNCTION GetTargetFromSignature (processSig: OSType; VAR targetDesc: AEAddressDesc): OSErr;
        VAR
            err: OSErr;

    BEGIN
        err := AECreateDesc(typeApplSignature, @processSIG, sizeof(processSig), targetDesc);
        GetTargetFromSignature := err;
    END;

{This routine will create a targetDesc by bringing up the PPCBrowser}
    FUNCTION GetTargetFromBrowser (promptStr: Str255; VAR targetDesc: AEAddressDesc): OSErr;
        VAR
            err: OSErr;
            theTarget: TargetID;
            portInfo: PortInfoRec;

    BEGIN
        err := PPCBrowser(promptStr, '', FALSE, theTarget.location, portInfo, NIL, '');
        IF (err = noErr) THEN
        BEGIN
            theTarget.name := portInfo.name;
            err := AECreateDesc(typeTargetID, @theTarget, sizeof(TargetID), targetDesc);
        END;
        GetTargetFromBrowser := err;
    END;


{
    This routine is the low level routine used by the SendODOCToSelf
    routine.  It gets passed the list of files (in an AEDescList)
    to be sent as the data for the 'odoc', builds up the event
    and sends off the event.

    It is broken out from SendODOCToSelf so that a SendODOCListToSelf could
    easily be written and it could then call this routine - but that is left
    as an exercise to the reader.

    Read the comments in the code for the order and details
}
    PROCEDURE _SendDocsToSelf (aliasList: AEDescList);
        VAR
            err: OSErr;
            theTarget: AEAddressDesc;
            openDocAE: AppleEvent;
            replyAE: AppleEvent;

    BEGIN
    {
        First we create the target for the event.   We call another
        utility routine for creating the target.
    }
        err := GetTargetFromSelf(theTarget);
        IF (err = noErr) THEN
        BEGIN
        {Next we create the Apple event that will later get sent.}
            err := AECreateAppleEvent(kCoreEventClass, kAEOpenDocuments, theTarget, kAutoGenerateReturnID, kAnyTransactionID, openDocAE);

            IF err = noErr THEN
            BEGIN
            {Now add the aliasDescList to the openDocAE}
                err := AEPutParamDesc(openDocAE, keyDirectObject, aliasList);

                IF err = noErr THEN
                BEGIN
                {
                    and finally send the event
                    Since we are sending to ourselves, no need for reply.
                }
                    err := AESend(openDocAE, replyAE, kAENoReply + kAECanInteract, kAENormalPriority, 3600, NIL, NIL);

                {
                    NOTE: Since we are not requesting a reply, we do not need to
                    need to dispose of the replyAE.  It is there simply as a
                    placeholder.
                }
                END;

            {
                Dispose of the aliasList descriptor
                We do this instead of the caller since it needs to be done
                before disposing the AEVT
            }
                err := AEDisposeDesc(aliasList);
            END;

        {and of course dispose of the openDoc AEVT itself}
            err := AEDisposeDesc(openDocAE);
        END;
    END;

{
    This is the routine called by SelectFile to send a single odoc to ourselves.

    It calls the above low level routine to do the dirty work of sending the AEVT -
    all we do here is build a AEDescList of the file to be opened.
}
    PROCEDURE SendODOCToSelf (theFileSpec: FSSpec);
        VAR
            err: OSErr;
            aliasList: AEDescList;
            aliasDesc: AEDesc;
            aliasH: AliasHandle;
    BEGIN
    {Create the descList to hold the list of files}
        err := AECreateList(NIL, 0, FALSE, aliasList);

        IF err = noErr THEN
        BEGIN
        {First we setup the type of descriptor}
            aliasDesc.descriptorType := typeAlias;

        {
            Now we add the file to descList by creating an alias and then
            adding it into the descList using AEPutDesc
        }
            err := NewAlias(NIL, theFileSpec, aliasH);
            aliasDesc.dataHandle := Handle(aliasH);
            err := AEPutDesc(aliasList, 0, aliasDesc);
            DisposHandle(Handle(aliasH));

        {Now call the real gut level routine to do the dirty work}
            _SendDocsToSelf(aliasList);

        {_SendDocsToSelf will dispose of aliasList for me}
        END;
    END;


    PROCEDURE SendQuitToSelf;
        VAR
            err: OSErr;
            theTarget: AEAddressDesc;
            QuitAE: AppleEvent;
            replyAE: AppleEvent;

    BEGIN
    {
        First we create the target for the event.   We call another
        utility routine for creating the target.
    }
        err := GetTargetFromSelf(theTarget);
        IF (err = noErr) THEN
        BEGIN
        {Next we create the Apple event that will later get sent.}
            err := AECreateAppleEvent(kCoreEventClass, kAEQuitApplication, theTarget, kAutoGenerateReturnID, kAnyTransactionID, QuitAE);

            IF err = noErr THEN
            BEGIN
            {
                and send the event
                Since we are sending to ourselves, no need for reply.
            }
                err := AESend(QuitAE, replyAE, kAENoReply + kAECanInteract, kAENormalPriority, 3600, NIL, NIL);

            {
                NOTE: Since we are not requesting a reply, we do not need to
                need to dispose of the replyAE.  It is there simply as a
                placeholder.
            }
            END;

        {Dispose of the quit AEVT itself}
            err := AEDisposeDesc(QuitAE);
        END;
    END;

END.