Developer CD Series 1992 …SCII & the Runetime Code/ADC Developer CD (1992-07) (''Butch ASCII And The Runtime Code'')_iso/Dev.CD 199207.iso/Development Platforms/Apple II/DTS Apple II Sample Code/IR 2.0/Source Code/IR Module/IRModule.p

Text File | 1992-02-25 | 14.5 KB | 441 lines | [TEXT/MPS ]

{
    IR module in MPW IIgs Pascal

    Matt Deatherage, 12/11/91

    Based on:
    Sample Nifty List module in MPW IIgs Pascal
    4-Dec-91 Dave Lyons

   Revision history:

   2.0a3       Matt Deatherage      12/12/91

   First release of file.  All string types of odd length due to a strange bug
   in PLib 1.1a27 that makes string copying of strings of odd length (including
   length bytes) fail if the strings cross a bank boundary.  So, to be safe, all
   string types are of odd length so they'll take an even number of bytes with
   the length byte.

   2.0a4       Matt Deatherage      12/18/91

   cmdIRInstall was checking the low bit of OS_KIND instead of checking for
   a value of $01.  It's now also reading a byte instead of a word.  Fixed.

   Locator.p updated so SendRequest declares target and dataIn as UNIV longint
   and dataOut as ptr.  Calls to SendRequest accordingly changed.

   cmdKillIR didn't actually remember to remove IR's request procedure before
   it called UserShutDown.  Now it does.

   Still no check for stack space -- trying to use some of these commands from
   P8 may overflow the stack and cause real problems.

   Library bug with even-length strings fixed, but the types are still the
   way they were in 2.0a3 because it's not hurting anything.

   2.0b1       Matt Deatherage      02/18/92

   cmdKillIR was fixed in 2.0a4 to remove the request procedure; now it does it
   by user ID instead of name since IR now appends the user ID to the name
   string.

   2.0b2       Matt Deatherage      02/20/92

   cmdGetIRPrefs now knows about the new irIgnoreProblems preference.

   2.0b3       Matt Deatherage      02/22/92

   Eliminated message on entry to Nifty List (to be nice to Dave).  Changed
   cmdIRInstall to correctly return the Tool Locator error if IR didn't
   change the result code in the buffer.

    2.0f1            Matt Deatherage        02/24/92

    Added resource fork for version and two comment resources.  Open it and
    read what we need in actBirth; we don't use it anywhere else.  Before
    calling VersionString to get the version in ASCII form, we check for
    QDVersion 3.7 or greater to make sure we're running 6.0.  cmdIRInfo
    now displays that version number as well.  I even (eventually) remembered
    to save and restore the current resource application so if someone installs
    Nifty List from within an application I don't kill the app's resource fork.

    2.0            Matt Deatherage        02/25/92

    First release to the world.  No code changes from 2.0f1.

}

{[j=12-/32/80!,o=95,a-]}       {PasMat options}

UNIT IRModule;

   INTERFACE

      USES Types,Memory,Locator,QuickDraw,Misctool,GSOS,Loader,Resources,GSBug,NiftyList,IR;

         {$Z+}                 { Export these procedures and functions. These are in the
                                assembly file. }

      FUNCTION NDAOpen: ptr;

      PROCEDURE NDAAction(Code: Integer; Param: Longint);
      {$Z-}

   IMPLEMENTATION

      CONST
         numCommandsPlusTwo = 8; { first one is special }

      TYPE
         commandTableType = ARRAY [1..numCommandsPlusTwo] OF
                               RECORD
                                  cmdName: ptr; { to Pascal string }
                                  cmdProc: procPtr;
                                  helpProc: procPtr;
                               END;

         Str127      = String[127];

      VAR
         InfoRec    : ModuleInfoType;
         myCommandTable: commandTableType;
         TestText   : String[39];
         d          : Longint; { dummy }
         tempString : Str255;
         moduleName,commandKillIR,commandIRInfo,commandGetIRPrefs,commandSetIRPrefs,
         commandDoIRPrefs,commandIRInstall: String[31];

         myEvalBuffer: EvalExprBuffer;
         myRangeBuffer: GetRangeBuffer;
         GFIBuffer  : FileInfoRecGS;
         IRString,ModuleVersion: String32;

      FUNCTION NLService(Param: UNIV Longint; Code: Integer): Longint;

         BEGIN
    { dummy function -- first four bytes get patched at runtime to
                        jump into Nifty List }
         END;

      PROCEDURE WriteCR;

         BEGIN
            d := NLService(NIL,nlCrout);
         END;

        PROCEDURE DisplayLineNoCR(theText: Str127);

            BEGIN
                d := NLService(@theText,nlWriteStr);
            END;

      PROCEDURE DisplayLine(theText: Str127);

         BEGIN
            d := NLService(@theText,nlWriteStr);
            WriteCR;
         END;

      PROCEDURE DisplayErrorLine(theText: Str127; theError: Integer);

         VAR
            temp       : Longint;

         BEGIN
            d := NLService(@theText,nlWriteStr);
            temp := theError;
            d := NLService(temp,nlWriteWord);
            WriteCR;
         END;

      PROCEDURE helpModule;

         BEGIN
            DisplayLineNoCR('IR Module ');
                DisplayLineNoCR(ModuleVersion);
                DisplayLine(':');
            DisplayLine('  \killir      \irinfo      \getirprefs  \setirprefs');
            DisplayLine('  \doirprefs   \irinstall');
         END;

      PROCEDURE helpKillIR;

         BEGIN
            DisplayLine('\killir -- Attempts to remove IR from memory');
         END;

      PROCEDURE cmdKillIR;

         VAR
            mySRQRecord: srqGoAwayOut;
            myErr      : OSErr;
            IRID       : Integer;

         BEGIN
            WriteCR;
            SendRequest(srqGoAway,sendToName + stopAfterOne,@IRString,0,@mySRQRecord);
            IF _toolErr = 0 THEN BEGIN
               AcceptRequests(NIL,mySRQRecord.resultID,NIL);
               IRID := UserShutDown(mySRQRecord.resultID,0);
               DisplayErrorLine('IR''s user ID was $',IRID);
            END
            ELSE
               DisplayErrorLine('Couldn''t kill IR -- error $',_toolErr);
         END;

      PROCEDURE helpIRInfo;

         BEGIN
            DisplayLine('\irinfo -- determines if IR is present');
         END;

      PROCEDURE cmdIRInfo;

         VAR
            myInfoRec  : IRInputRecord;
                IRVersion  : string[10];

         BEGIN
            WriteCR;
            SendRequest(askIRAreYouThere,sendToName + stopAfterOne,@IRString,0,@myInfoRec);
            IF _toolErr = 0 THEN BEGIN
                    VersionString(0,myInfoRec.version,@IRVersion);
               DisplayLineNoCR('IR version ');
                    DisplayLineNoCr(IRVersion);
                    DisplayErrorLine(' is installed with user ID $',myInfoRec.userID);
                END
            ELSE
               DisplayLine('IR is not installed.');
            WriteCR;           { extra blank line }
         END;

      PROCEDURE helpGetIRPrefs;

         BEGIN
            DisplayLine('\getirprefs -- Returns IR''s current preferences');
         END;

      PROCEDURE cmdGetIRPrefs;

         VAR
            myPrefs    : askGetPrefsOutputRecord;

         BEGIN
            WriteCR;
            SendRequest(askIRGetPrefs,sendToName + stopAfterOne,@IRString,0,@myPrefs);
            IF _toolErr = 0 THEN BEGIN
               DisplayLine('IR''s current preferences:');
               IF BAND(myPrefs.preferences,irNoDuplicates) <> 0 THEN
                  DisplayLine('    Duplicates not allowed');
               IF BAND(myPrefs.preferences,irKillDuplicates) <> 0 THEN
                  DisplayLine('    Duplicates must be removed');
               IF BAND(myPrefs.preferences,irDontOpenNDAs) = 0 THEN
                  DisplayLine('    Open new NDAs after installing');
               IF BAND(myPrefs.preferences,irKillFinderExts) <> 0 THEN
                  DisplayLine('    Remove Finder extensions when quitting Finder');
               IF BAND(myPrefs.preferences,irCopyExistNDAs) = 0 THEN
                  DisplayLine('    Open existing NDAs if possible instead of installing');
               IF BAND(myPrefs.preferences,irWaitOpenFailed) <> 0 THEN
                  DisplayLine(
                          '    Respond to finderSaysOpenFailed instead of finderSaysBeforeOpen'
                              );
               IF BAND(myPrefs.preferences,irIgnoreProblems) <> 0 THEN
                  DisplayLine('    Don''t inform user about problems');
            END                { if _toolErr }
            ELSE
               DisplayErrorLine('Getting preferences failed -- error $',myPrefs.irError);
            WriteCR;

         END;

      PROCEDURE helpSetIRPrefs;

         BEGIN
            DisplayLine('xxxx\setirprefs -- sets IR''s current preferences');
         END;

      PROCEDURE cmdSetIRPrefs;

         VAR
            myPrefs    : askSetPrefsOutputRecord;

         BEGIN
            d := NLService(@myRangeBuffer,nlGetRange);

            SendRequest(askIRSetPrefs,sendToName + stopAfterOne,@IRString,
                        myRangeBuffer.rawStart,@myPrefs);
            IF _toolErr <> 0 THEN
               DisplayErrorLine('Setting preferences failed -- error $',myPrefs.irError);
            WriteCR;

         END;

      PROCEDURE helpDoIRPrefs;

         BEGIN
            DisplayLine('doirprefs -- performs the IR preferences dialog if possible');
         END;

      PROCEDURE cmdDoIRPrefs;

         BEGIN
            SendRequest(askIRDoPrefs,sendToName + stopAfterOne,@IRString,0,NIL);
         END;

      PROCEDURE helpIRInstall;

         BEGIN
            DisplayLine(
             'xxxx\irinstall "pathname" -- ask IR to install pathname with optional flags xxxx'
                        );
         END;

      PROCEDURE cmdIRInstall;

         VAR
            installInput: askInstallInputRecord;
            installOutput: askInstallOutputRecord;
            osKind     : Byte;

         BEGIN

            WriteCR;
            osKind := LoWrd(NLService($E100BC,nlGetByte));
            IF osKind = 1 THEN BEGIN

               d := NLService(@myRangeBuffer,nlGetRange);
               d := NLService(@myEvalBuffer,nlEvalExpr);

               installInput.flags := myRangeBuffer.rawStart;
               installInput.pathname := @myEvalBuffer.actExprSize;
               installOutput.irError := 0;

               GFIBuffer.pCount := 4;
               GFIBuffer.pathname := installInput.pathname;

               GetFileInfoGS(GFIBuffer);

               IF _toolErr = 0 THEN BEGIN
                  installInput.filetype := GFIBuffer.filetype;
                  installInput.auxtype := GFIBuffer.auxtype;

                  SendRequest(askIRToInstall,sendToName + stopAfterOne,@IRString,@installInput,
                              @installOutput);

                  IF _toolErr <> 0 THEN
                     IF installOutput.irError <> 0 THEN
                        DisplayErrorLine('Installation failed -- IR returned result $',
                                         installOutput.irError)
                     ELSE
                        DisplayErrorLine('Installation failed -- IR Module got error $',
                                         _toolErr)
                  ELSE
                     DisplayErrorLine('Installation succesful -- the new file has user ID $',
                                      installOutput.userID);

               END
               ELSE
                  DisplayErrorLine('GS/OS error $',_toolErr)

            END
            ELSE
               DisplayLine('IR can''t install if GS/OS isn''t active.');
            WriteCR;
         END;

      FUNCTION NDAOpen: ptr;

         BEGIN
            { First entry is for the module itself }
            moduleName := concat('IR Module ',ModuleVersion);
            WITH myCommandTable[1] DO BEGIN
               cmdName := @moduleName;
               cmdProc := NIL;
               helpProc := @helpModule; { displays command summary }
            END;
            commandKillIR := 'killir';
            WITH myCommandTable[2] DO BEGIN
               cmdName := @commandKillIR;
               cmdProc := @cmdKillIR;
               helpProc := @helpKillIR;
            END;
            commandIRInfo := 'irinfo';
            WITH myCommandTable[3] DO BEGIN
               cmdName := @commandIRInfo;
               cmdProc := @cmdIRInfo;
               helpProc := @helpIRInfo;
            END;
            commandGetIRPrefs := 'getirprefs';
            WITH myCommandTable[4] DO BEGIN
               cmdName := @commandGetIRPrefs;
               cmdProc := @cmdGetIRPrefs;
               helpProc := @helpGetIRPrefs;
            END;
            commandSetIRPrefs := 'setirprefs';
            WITH myCommandTable[5] DO BEGIN
               cmdName := @commandSetIRPrefs;
               cmdProc := @cmdSetIRPrefs;
               helpProc := @helpSetIRPrefs;
            END;
            commandDoIRPrefs := 'doirprefs';
            WITH myCommandTable[6] DO BEGIN
               cmdName := @commandDoIRPrefs;
               cmdProc := @cmdDoIRPrefs;
               helpProc := @helpDoIRPrefs;
            END;
            commandIRInstall := 'irinstall';
            WITH myCommandTable[7] DO BEGIN
               cmdName := @commandIRInstall;
               cmdProc := @cmdIRInstall;
               helpProc := @helpIRInstall;
            END;
            { Last entry terminates list by having NIL for command name }
            WITH myCommandTable[8] DO BEGIN
               cmdName := NIL;
            END;

            WITH InfoRec DO BEGIN
               size := sizeof(InfoRec);
               format := 0;
               patchType := 0;
               patch := @NLService;
               bytesPerCommand := 12;
               cmdTable := @myCommandTable[1];
            END;
            myEvalBuffer.maxExprSize := sizeof(myEvalBuffer);
            myEvalBuffer.actExprSize := 0;
            IRString := 'Apple~IR~';
            NDAOpen := @InfoRec;
         END;

      PROCEDURE NDAAction(Code: Integer; Param: Longint);

         VAR

            resApp, resFile    : Integer;
            versHandle : Handle;

         BEGIN
            CASE Code OF
               actBirth: BEGIN
                        resApp := GetCurResourceApp;
                        ResourceStartUp(MMStartUp);
                  resFile := OpenResourceFile(1,NIL,GSString255Ptr(LGetPathname2(MMStartUp,
                             1)));
                  IF _toolErr = 0 THEN BEGIN
                     versHandle := LoadResource(rVersion,1);
                     IF ((_toolErr = 0) and (QDVersion >= $0307)) THEN BEGIN
                        HLock(versHandle); { not locked in resource file because the Finder
                                            uses this, too }
                        VersionString(0,NLService(versHandle^,nlGetLong),
                                      @ModuleVersion);
                     END;      { _toolErr/QDVersion from LoadResource }
                  END;         { _toolErr from OpenResourceFile }
                  ResourceShutDown; { closes our files for us }
                        SetCurResourceApp(resApp);
               END;            { actBirth }
            END;               { case }
         END;                  { NDAAction }
END.