Carousel Volume 2 #1/carousel.iso/mactosh/code/ras_stre.sit

Text File | 1988-06-20 | 73.2 KB | 2,549 lines

18-Jun-88 14:46:48-MDT,77448;000000000000
Return-Path: <[e-mail]>
Received: from cs.utah.edu by SIMTEL20.ARPA with TCP; Sat, 18 Jun 88 14:45:17 MDT
Received: by cs.utah.edu (5.54/utah-2.0-cs)
    id AA22671; Sat, 18 Jun 88 14:45:16 MDT
Received: by sunset.utah.edu (5.54/utah-2.0-leaf)
    id AA24809; Sat, 18 Jun 88 14:45:08 MDT
Date: Sat, 18 Jun 88 14:45:08 MDT
From: [e-mail] (Lee Choquette)
Message-Id: <[e-mail]>
To: [e-mail]
Subject: StreamLib.ras




                    __StreamLib:  A Rascal Library

                           for Stream Input



Introduction
-----------------------------------------------------------------------


__StreamLib comprises a set of routines which allow programs to read
TEXT and/or WORD (MacWrite) files as a stream of characters, without
having to know or care about which type of file is being read.  A
stream can be opened and then read by operations that return either a
character at a time or a line at a time.  There are also sets of
operations that work exclusively on each type of file, should the user
wish to restrict program operation to TEXT files only or to WORD files
only.  Explicit use of a single stream type reduces the amount of code
linked in (although the amount is small).  Use of the routines that
work on both kinds of files incurs a small penalty in code size but
increases the generality of the program:  any program that operates on
simple text files can be made to operate on MacWrite files as well.


To use the library, one first initializes it, then opens a stream and
reads its contents.  Streams are closed automatically when the end of
the stream is reached.  The stream can be read a character or a line at
a time.  Two small programs to read a file and display it follow.

        Proc CharReadStream (); (* read stream a character at a time *)
        Var
                c: Integer;
        {
                InitStream ();
                if OpenStream () <> noErr then
                {
                        loop (,,,)
                        {
                                c := StreamGetC ();
                                if c = -1 then
                                        break;  (* end of stream *)
                                WriteChar (c);
                                if c = ' then
                                        WriteChar (');
                        };
                };
        };


        Proc LineReadStream (); (* read stream a line at a time *)
        Var
                buf: Byte[512]; (* should be big enough! *)
        {
                InitStream ();
                if OpenStream () <> noErr then
                {
                        loop (,,,)
                        {
                                if StreamGetS (buf) = nil then
                                        break;  (* end of stream *)
                                WriteString (buf);
                                WriteLn ();
                        };
                };
        };

If one wishes to know something about the stream, the procedure
GetStreamInfo is available.  This returns a copy of the SFReply used to
open the stream (i.e., it contains the file name, file type, and volume
reference number.

Most of the routines in __StreamLib are described below.  Routines with
names beginning with an underscore are primarily intended for internal
use, but they might be useful in certain contexts.


Stream Initialization, Opening and Closing
-----------------------------------------------------------------------


Procedure InitStream ();

This procedure must be called to set up the library before any other
stream operations are done.


Function OpenStream (): OSErr;

Open a stream.  Closes any currently open stream, then displays a
GetFile dialog listing both TEXT and WORD files.


Function OpenTextStream (): OSErr;

Like OpenStream, but for TEXT files only.


Function OpenWordStream (): OSErr;

Like OpenStream, but for WORD files only.


OpenStream, OpenTextStream and OpenWordStream return:

        noErr           stream opened successfully
        fnOpnErr        stream not opened successfully
        mFulErr         (occurs for WORD files only) stream could be
                        opened, but there was not enough memory to read
                        in initialization information (the stream is
                        closed before returning)


Procedure CloseStream ();

Close the currently open stream.  The character and line input routines
(described below) close the stream automatically upon reaching end of
stream, but CloseStream may be called safely any time after InitStream
is called (even before the first stream is opened!).


Character Input Routines
-----------------------------------------------------------------------


Function StreamGetC (): Integer;

Determine the type of the stream and get the next character
appropriately.


Function TextStreamGetC (): Integer;

Get the next character from the currently open TEXT stream.  Results
meaningless if the stream is a WORD stream.


Function WordStreamGetC (): Integer;

Get the next character from the currently open WORD stream.  Results
meaningless if the stream is a TEXT stream.


StreamGetC, TextStreamGetC and WordStreamGetC return:

        -1              end of stream
        otherwise       next character of stream

Note that the result must be assigned to an integer variable, since -1
is not a legal byte value.

When the end of the stream is reached, these routines close the stream.
Further calls return -1 repeatedly until another stream is opened.


Line Input Routines
-----------------------------------------------------------------------


Function StreamGetS (str: StringPtr): StringPtr;

Determine the type of the stream and get the next line appropriately.
Place the line in the given string.


Function TextStreamGetS (str: StringPtr): StringPtr;

Get the next line (all characters up to the next carriage return or end
of stream) from the currently open TEXT stream.  Place the line in the
given string.  The carriage return is not placed in the string.
Results meaningless if the stream is a WORD stream.


Function WordStreamGetS (str: StringPtr): StringPtr;

Get the next line from the currently open WORD stream.  A "line" is
defined as a string of characters up to the next carriage return or end
of stream, or up to the first space past the current linewrap length.
Lines must be broken at some point, since WORD files contain carriage
returns only at the ends of paragraphs, and it cannot be assumed that
paragraphs will be less than any reasonable length.  Therefore, once a
certain number of characters have been read without a carriage return
being found, the next space causes the call to terminate.  (If you
really need to read in a whole paragraph, use WordStreamGetC until it
returns a carriage return.)

The line is placed in the given string.  The carriage return (or space
if the line is broken) is not placed in the string.  Results
meaningless if the stream is a TEXT stream.


StreamGetS, TextStreamGetS and WordStreamGetS return:

        nil             end of stream
        otherwise       pointer to the argument

When the end of the stream is reached, these routines close the stream.
Further calls return nil repeatedly until another stream is opened.


Miscellaneous Routines
-----------------------------------------------------------------------


Procedure GetStreamInfo (streamInfo: SFReply);

Returns, in the argument, a copy of the SFReply record used to open the
stream (from which the file name, file type and file volume reference
number can be determined).  This information is meaningless unless a
stream is actually open.


Procedure SetLineLen (len: Integer);

Sets the line wrap length for WordStreamGetS.


Function _FSOpen (fName: PtrB; vRefNum: Integer; refNum: ^Integer;
                                mode: Integer): OSErr;

This function is similar to FSOpen (in Inside Macintosh) except that it
allows an open mode to be specified.


Procedure _ffRead (f: Integer; b: PtrB; amount: LongInt);

Reads amount bytes from the file f into the buffer pointed to by b.


Procedure _fMoveTo (f: Integer; pos: LongInt);

Moves to position pos in file f.


Limitations
-----------------------------------------------------------------------


Only one file at a time can be streamed.


Acknowledgments
-----------------------------------------------------------------------


The code which extracts the text from WORD files is modelled after the
programs ReadMacWrite and Index, by Scott Gillespie (Reed College).
Scott is of course not responsible for any glaring ugliness in my code.
The main differences between his code and mine are:  In ReadMacWrite
the text extractor is a high-level routine that repeatedly passes
characters to subsidiary routines, while in __SteamLib the extractor is
a subsidiary routine repeatedly called by higher-level operations in
the host program.  Also, I used a Handle rather than a Ptr for reading
in each paragraph.  I found that DA's using the library would not
execute properly when they were run inside of other programs not
created with Rascal - SetPtrSize always failed.  I don't know why.

--


Program __StreamLib;

(*
    __StreamLib - set of routines for treating TEXT or WORD files as a
    stream of characters or lines.  To use:

    Call InitStream() first.  Call OpenStream() to open a stream.  If it
    returns noErr, a stream was opened ok.  To read characters, call
    StreamGetC().  This returns the next character or -1 on end of stream
    (and closes the stream).  To read lines, call StreamGetS(buf).  This
    fills up the buffer passed to it and returns a pointer to it, or nil
    on end of stream (and closes the stream).  To close a stream early,
    call CloseStream().

    There are also corresponding routines for reading TEXT files only, or
    WORD files only.  See below.  These are useful if you want to end up
    with less code linked into your program.

    To compile this library:

        Select Batch... from the Options Menu
        Select Compile Same (or Compile...) for Step 1).
        Select Combine Same for Step 2).
        Click OK.

    Version 1.0     11 March 1986

    Paul DuBois
    Wisconsin Regional Primate Research Center
    1220 Capitol Court
    University of Wisconsin-Madison
    Madison, WI  53706

    UUCP: {allegra, ihnp4, seismo}!uwvax!uwmacc!dubois

*)

Uses
    __OSTraps
    (*$U+*)
    uOSIntf
    uPackIntf
    ;

Link
    __OSTraps
    :;

Const
    bufSiz = 1024;

    wordStream = 1; (* stream is of 'WORD' file *)
    textStream = 2; (* stream is of 'TEXT' file *)

    paraLen = 16;   (* paragraph information 16 bytes long *)

Type
    IArray = Record         (* Information array element *)
        height: integer;
        pagepos: integer;
        parahand: ^^longint;
        StPos: Union
            St: byte;       (* first byte is status *)
            Pos: longint;
        End;
        DataLength: integer;
        formats: Integer;
    End;

Var
    theReply: SFReply;      (* SFGetFile reply record *)
    f: Integer;             (* input file reference number *)
    streamOpen: Boolean;    (* whether stream currently open *)
    streamType: Integer;    (* wordStream or textStream *)

(*  vars needed for TEXT stream only *)

    filBuf: Byte[bufSiz];   (* file buffer *)
    fChars: LongInt;        (* number of chars gotten on last read *)
    fIndex: Integer;        (* current position in filBuf *)

(*  vars needed for WORD stream only *)

    paraBuf: ^^Byte[1];
    infoHand: ^^Iarray[1];
    compressed: Boolean;
    inPara: Boolean;
    nParas: Integer;    (* number of paragraphs *)
    paraNum: Integer;   (* current paragraph number *)
    pIndex: Integer;    (* index into paragraph *)
    pChars: Integer;    (* number of chars extracted from paragraph *)
    firstHalf: Boolean; (* which half of current index char *)
    pLen: Integer;      (* number of chars in paragraph *)
    needNib,            (* For Decompr.: true = 2nd Nibble needed for ascii *)
    nextAsc: boolean;   (* For Decompr.: true = Two Nibbles needed *)
    lastNib: byte;      (* For Decompr.: Holds last nibble *)
    lineLen: Integer;   (* for line wrapping *)


(* -------------------------------- *)
(*  miscellaneous utility routines  *)
(* -------------------------------- *)

Proc _ffRead (f: Integer; b: PtrB; amount: LongInt);
{
    amount := FSRead(f, @amount, b);
};

Proc _fMoveTo (f: Integer; amt: LongInt);
Var
    result: Integer;
{
    result := SetFPos (f, fsFromStart, amt);
};


(* --------------------------------- *)
(*  stream init/open/close routines  *)
(* --------------------------------- *)


(*
    InitStream - must be called before you do anything else.

    _FSOpen - like FSOpen (in __OSTraps), but has open mode parameter.

    _OpenStream - Open a file for stream I/O.  numTypes is either 1 or 2,
        and typeList is either 'TEXT', 'WORD', or 'TEXTWORD'.
        Return noErr if file opened OK, or fnOpnErr if not.
        if OK, set streamType to wordStream or textStream,
        according to the type of the opened file, and set
        fileOpen true.

    OpenTextSream - open 'TEXT' file stream.  Returns:
        noErr - file open OK
        fnOpnErr - file not open

    OpenWordSream - open 'WORD' file stream.  Returns:
        noErr - file open OK
        fnOpnErr - file not open
        mFulErr - couldn't get memory to read paragraph info into memory.
            file not open.

    OpenSream - open 'TEXT' or 'WORD' stream.  Return values same as for
        OpenWordS.  Returns stream type in function argument sType.

    _WordStreamInit does special handling necessary for 'WORD' stream:
    Open the file, advance 252 + 12 bytes (to start of main document info
    + offset of Information Array.  Then read position and length of Info
    Array, move to it, read it in, and calculate number of paragraphs.
    (16 bytes info per paragraph.)  _TextStreamInit does TEXT stream
    specific initialization.
*)

Proc InitStream ();
{
    streamOpen := false;
    lineLen := 65;
    paraBuf := nil;
    infoHand := nil;
};


Proc CloseStream ();
Var
    result : OSErr;
{
    if streamOpen then
    {
        result := FSClose (f);
        streamOpen := false;
        if streamType = wordStream then
        {
            if paraBuf <> nil then DisposHandle (paraBuf);
            if infoHand <> nil then DisposHandle (infoHand);
        };
    };
};


Func _FSOpen (fName: PtrB; vRefNum: Integer;
              refNum: ^Integer; mode: Integer): OSErr;
Var
    p: ParamBlockRec;
{
    p.ioNamePtr := fName;
    p.ioVRefNum := vRefNum;
    p.ioPermssn := mode;
    p.ioVersNum := 0;
    p.ioMisc := 0;
    _FSOpen := PBOpen (p, false);
    refnum^ := p.ioRefNum;
};


Func _OpenStream (numTypes: Integer; typeList: OSType): OSErr;
{
    CloseStream ();         (* close any currently open stream *)
    _OpenStream := fnOpnErr;
    streamOpen := false;

    ToolBox ($A9EA, 100, 70, "", nil, numTypes, typeList, nil, @theReply, 2);
    if theReply.good then
    {
        if _FSOpen(theReply.fName, theReply.vRefNum, @f, fsRdPerm) = noErr then
        {
            streamType := wordStream;
            if theReply.fType = PtrL (" TEXT"+2)^ then
                streamType := textStream;
            streamOpen := true;
            _OpenStream := noErr;
        };
    };
};


Proc _TextStreamInit ();
{
    fChars := 0;    (* set these to trigger a read on the first *)
    fIndex := 0;    (* call to TextStreamGetC() *)
};


Func _WordStreamInit (): OSErr;
Type
    DocVars = Record
        IApos: Longint;
        IAlength: Integer;
    End;
Var
  docVars: DocVars;
{
    paraBuf := NewHandle (0L);  (* Will be used for reading in paragraphs *)
    _fmoveto (f, 264L);       (* 252 + 12 *)
    _ffRead (f, docVars, LongInt (SizeOf (DocVars)));
    _fMoveTo (f, docVars.IAPos);
    infoHand := NewHandle (Longint (docVars.IALength));
    if infoHand = nil then
    {
        CloseStream ();
        _WordStreamInit := mFulErr;
    }
    else
    {
        HLock (InfoHand);
        _ffRead (f, infoHand^, Longint (docVars.IALength));
        HUnlock (InfoHand);

        nParas := docVars.IALength/paraLen;
        paraNum := -1;
        inPara := false;            (* not in any paragraph yet *)
        _WordStreamInit := noErr;
    };
};


Func OpenTextStream (): OSErr;
{
    OpenTextStream := _OpenStream (1, " TEXT"+2);
    _TextStreamInit ();
};


Func OpenWordStream (): OSErr;
Var
    result: OSErr;
{
    OpenWordStream := fnOpnErr;
    if _OpenStream (1, " WORD"+2) = noErr then
        OpenWordStream := _WordStreamInit ();
};


Func OpenStream (): OSErr;
{
    OpenStream := fnOpnErr;
    if _OpenStream (2, " TEXTWORD"+2) = noErr then
    {
        OpenStream := noErr;
        case streamType of
            wordStream: OpenStream := _WordStreamInit ();
            textStream: _TextStreamInit ();
        end;
    };
};


Proc GetStreamInfo (reply: SFReply);
{
    reply := theReply;
};


(*
    'Get a character' routines

    TextStreamGetC - get character from 'TEXT' stream.
    WordStreamGetC - get character from 'WORD' stream.
    StreamGetC - get character from stream.
*)

Func TextStreamGetC (): Integer;
Var
    err: OSErr;
{
    TextStreamGetC := -1;
    if streamOpen = false then return;
    if fIndex >= fChars then    (* need to read in a new block *)
    {
        fChars := bufSiz;
        err := FSRead (f, @fChars, filBuf);
        if fChars = 0 then
        {
            CloseStream ();
            return;
        };
        fIndex := 0;
    };
    TextStreamGetC := filBuf[fIndex];
    ++fIndex;
};


(*
    _Decompress takes a nibble at a time of compressed text.  If more
    nibbles are needed to complete the next character, return -1, else
    returns the character.
*)

Func _Decompress (b: Byte): Integer;
{
    _Decompress := -1;
    if needNib then             (* Low half of ascii nibble is needed. *)
    {
        needNib := false;
        _Decompress := (lastNib or b);  (* Put the two halves together *)
    }
    else if nextasc then        (* Two nibbles are needed *)
    {
        nextAsc := false;
        lastNib := b << 4;      (* Save this one as the high nibble *)
        needNib := true;        (* Need one more nibble *)
    }
    else if b = 15 then         (* Nibble of 15 means the next char is ascii *)
        nextAsc := true
    else          (* Add the nibble value to the English decompression *)
                  (* key (saved as Resource Type "STR " 700 in file)   *)
                  (* to get the proper character *)
    {
        _Decompress := PtrB (++b + " etnroaisdlhcfp")^;
    };
};


Func WordStreamGetC (): Integer;   (* return -1 on EOF *)
Var
    c: Integer;
    offset: LongInt;
{
    WordStreamGetC := -1;
    if streamOpen = false then return;
    if inPara = false then      (* must read in next paragraph *)
    {
        loop (,,,)
        {
            if ++paraNum >= nparas then
            {
                CloseStream ();
                return;
            };
            if infoHand^^[paranum].height <= 0 then continue;
(*
    offset will contain the file offset to this paragraph's data.  must
    mask the high byte.  Move to the paragraph, get its length, make
    the pointer big enough, and read it in.  (skip to next para if this
    one is empty, though.)
    compressed will be set true if the paragraph is compressed.
*)
            offset := infoHand^^[paranum].stpos.pos and $00FFFFFF;
            _fMoveTo (f, offset);
            _ffRead (f, @plen, LongInt (SizeOf (Integer))); (* get length *)
            if plen = 0 then continue;
            SetHandleSize (paraBuf, LongInt (plen));    (* make big enough *)
            if MemError () <> noErr then
            {
                paranum := nparas;  (* force close and exit of loop *)
                continue;
            };
            _ffRead (f, paraBuf^, LongInt (plen));
            compressed := (infoHand^^[paranum].stpos.st >> 3) and 1;
            inPara := true;
            nextAsc := false;
            needNib := false;
            pIndex := 0;        (* index into current paragraph *)
            pChars := 0;        (* chars extracted from current paragraph *)
            firstHalf := true;  (* use first half of current index char *)
            break;
        };
    };
(*
    At this point, know eitherthat we have a new non-empty paragraph, or
    are still in the previous one.
*)
    if !compressed then  (* uncompressed *)
    {
        c := paraBuf^^[pchars];
    }
    else
    {
        loop (,,, c <> -1)
        {
            c := paraBuf^^[pIndex];
            if firstHalf then
            {
                c := _Decompress (Byte (c >> 4));
            }
            else
            {
                c := _Decompress (Byte (c and $0f));
                ++pIndex;   (* go to next char at next index *)
            };
            firstHalf := !firstHalf;
        };
    };
    if ++pChars >= pLen then    (* see if need new paragraph next time *)
        inPara := false;
    WordStreamGetC := c;
};


Func StreamGetC (): Integer;
{
    case streamType of
        wordStream: StreamGetC := WordStreamGetC ();
        textStream: StreamGetC := TextStreamGetC ();
    end;
};


(*
    'Get a string' routines

    TextStreamGetS - get string from 'TEXT' stream.
    WordStreamGetS - get string from 'WORD' stream.
    StreamGetS - get string from stream.

    All return nil if no string obtained, otherwise a pointer to the argument.
*)


Func TextStreamGetS (s: StringPtr): StringPtr;
Var
    c: Integer;
{
    TextStreamGetS := nil;
    if !streamOpen then return;
    s[0] := 0;  (* clear string *)
    loop (,,,)
    {
        c := TextStreamGetC ();
        if c = -1 then
            break;
        TextStreamGetS := s;   (* got something, so NextLine succeeds *)
        if c = 13 then break;
        s[++s[0]] := c;       (* add char to end *)
    };
};


Func WordStreamGetS (s: StringPtr): StringPtr;
Var
    c: Integer;
{
    WordStreamGetS := nil;
    if !streamOpen then return;
    s[0] := 0;  (* clear string *)
    loop (,,,)
    {
        c := WordStreamGetC ();
        if c = -1 then
            break;
        WordStreamGetS := s;   (* got something, so NextLine succeeds *)
        if (c = 13) or ((s[0] > lineLen) and (c = ' ')) then
            break;
        s[++s[0]] := c;       (* add char to end *)
    };
};


Func StreamGetS (s: StringPtr): StringPtr;
{
    case streamType of
        wordStream: StreamGetS := WordStreamGetS (s);
        textStream: StreamGetS := TextStreamGetS (s);
    end;
};


(*
    Set wrap length (number of chars after which point the line will be
    broken at the next space if a carriage return is not seen first).  This
    only affects TextStreamGetS (or StreamGetS when the current stream is
    a WORD stream).
*)

Proc SetLineLen (len: Integer);
{
    lineLen := len;
};


--
                                                                    |
Paul DuBois     {allegra,ihnp4,seismo}!uwvax!uwmacc!dubois        --+--
                                                                    |
                                                                    |
Path: utah-cs!seismo!uwvax!uwmacc!dubois
From: [e-mail] (Paul DuBois)
Newsgroups: net.sources.mac
Subject: Source for Grep-Wc DA
Message-ID: <[e-mail]>
Date: 17 Mar 86 17:00:33 GMT
Distribution: net
Organization: UW-Madison Primate Center
Lines: 1752


This posting contains several files:

uGrep.src     "Uses" file with all constants and types needed to
         compile Grep-Wc
GrepPatStuff.src Pattern-compiling, matching and entry routines
Grep-Wc.src     Main program
Grep-Wc.rsrc.Hqx BinHex of Grep-Wc resources
AddRes.src     Utility for transferring resources (not necessary,
         but very helpful)

You will also need the stream library stuff (__StreamLib.src - separate
posting).

The pattern compilation and matching routines are based in algorithms
found in the Software Tools (Kernighan and Plauger).  The resource
copying stuff in AddRes is similar to some parts of the Rascal program
MakeAppl.  uGrep.src is a conglomeration of parts of Rascal "Uses" files,
but since there is very little there that isn't listed explicitly in
Inside Macintosh, I don't expect that I am violating any rules by posting
it.


To recreate Grep-Wc from the source code, do the following
steps:

Launch Rascal
Compile __StreamLib.src to get __StreamLib.ras
Compile uGrep.src to get uGrep.ras
Compile GrepPatStuff.src to get GrepPatStuff.ras
Compile Grep-Wc.src to get Grep-Wc.ras
Link Grep-Wc.ras to get Grep-Wc.obj.  DON'T execute it!!  (It needs
its own resources to run properly.)
Express AddRes.src to get AddRes.obj.  This program is a simple utility
which asks you to select two files, then copies all the resources from
the first one into the resource fork of the second one.  When you
run this, select Grep-Wc.rsrc as the first file ("Copy From") and
Grep-Wc.obj as the second file ("Copy To").  (You could use ResEdit
to accomplish the same task.)
Execute Grep-Wc.obj in Rascal to see if it works.  Assuming it does,
go on to the next step.
Execute DeskMaker.obj (you must have the version from the new Rascal
release).  Stretch/move the window to where you want it, select the
Object -> Desk Acc. menu item.  When the dialog comes up, change
the window type to 0 (zero).  Do NOT select "Test after make" (the
DA file that DeskMaker won't have the necessary owned resources).
Note the driver number that DeskMaker assigns to the new DA.  If
it's 26, then quit DeskMaker and use AddRes to copy Grep-Wc.rsrc into
the new DA file.  You're all set.
If the id was not 26, then use ResEdit to copy the resources from
Grep-Wc.rsrc into the new DA file, and change their owner id's to match
the driver number (don't change the sub-id's).  There are ALRT, DITL
and DLOG resources.  If you don't renumber them properly, Font/DA Mover
won't move them when you move the DA around.  See the discussion on
owned resources in the Resource Manager manual of Inside Macintosh
if you don't know what I'm talking about here.


#    This is a shell archive.
#    Remove everything above and including the cut line.
#    Then run the rest of the file through sh.
-----cut here-----cut here-----cut here-----cut here-----
#!/bin/sh
# shar:    Shell Archiver
#    Run the following text with /bin/sh to create:
#    uGrep.src
#    GrepPatStuff.src
#    Grep-Wc.src
#    Grep-Wc.rsrc.Hqx
#    AddRes.src
# This archive created: Mon Mar 17 10:50:22 1986
# By:    Paul DuBois (UW-Madison Primate Center)
echo shar: extracting uGrep.src '(8926 characters)'
sed 's/^XX//' << \SHAR_EOF > uGrep.src
XX
XXProgram uGrep;
XX
XX(*
XX    uGrep.  Uses file containing all Toolbox Types and Constants needed
XX             for Grep-Wc (gleaned from various u* files).  Many of the
XX             handles and pointers I simply declared as ^LongInt, however.
XX
XX*)
XX
XX(*$U+*)
XX(*$L+*)
XX
XX
XXCONST
XX
XX(*  from uMemTypes  *)
XX
XX   True = 1B;
XX   False = 0B;
XX   Nil = 0L;
XX
XX(*  from uQuickDraw  *)
XX
XX(*  from uToolIntf  *)
XX
XX    inGrow = 5;
XX
XX  (*control definition proc ID's*)
XX
XX  pushButProc   = 0;
XX
XX(*  from uOSIntf  *)
XX
XX  NoErr       =      0;     (* All is well *)
XX
XX  fsWrPerm  = 2;
XX
XX(*  from uPackIntf *)
XX
XXTYPE
XX
XX(*  from uMemTypes  *)
XX
XX   Boolean = Byte;
XX   char = Integer;
XX   SignedByte   = Byte;         (* any byte in memory *)
XX   Ptr         = PtrB;         (* blind pointer *)
XX   Handle       = ^PtrB;        (* pointer to a master pointer *)
XX   ProcPtr      = Ptr;         (* pointer to a procedure *)
XX   Fixed        = LongInt;      (* fixed point arithmetic type *)
XX
XX   Str255       =  Byte[256];   (* maximum string size *)
XX   StringPtr    = ^Str255;      (* pointer to maximum string *)
XX   StringHandle = ^StringPtr;   (* handle to maximum string *)
XX
XX(*  from uQuickDraw  *)
XX
XX     Style     =  Integer;  (* use this one. *)
XX     Pattern   =  Byte[8];
XX
XX   Point = Record
XX     Variant
XX         { v,h: integer ;};
XX     or  { vh:  longint ; };
XX   End;
XX
XX     Rect = Record
XX       Variant
XX          { top,left,bottom,right:  Integer ;};
XX       Or
XX          { topLeft,botRight: Point ; };
XX     End;
XX
XX
XX     BitMap = Record
XX       baseAddr: Ptr;
XX       rowBytes: Integer;
XX       bounds:  Rect;
XX     End;
XX
XX
XX
XX     RgnHandle = ^LongInt;
XX     QDProcsPtr = ^LongInt;
XX
XX
XX     GrafPtr  = ^GrafPort;
XX     GrafPort = Record
XX       device:     Integer;
XX       portBits:    BitMap;
XX       portRect:    Rect;
XX       visRgn:     RgnHandle;
XX       clipRgn:     RgnHandle;
XX       bkPat:     Pattern;
XX       fillPat:     Pattern;
XX       pnLoc:     Point;
XX       pnSize:     Point;
XX       pnMode:     Integer;
XX       pnPat:     Pattern;
XX       pnVis:     Integer;
XX       txFont:     Integer;
XX       txFace:     Style;
XX       txMode:     Integer;
XX       txSize:     Integer;
XX       spExtra:     Fixed;
XX       fgColor:     LongInt;
XX       bkColor:     LongInt;
XX       colrBit:     Integer;
XX       patStretch:  Integer;
XX       picSave:     Handle;
XX       rgnSave:     Handle;
XX       polySave:    Handle;
XX       grafProcs:   QDProcsPtr;
XX     End;
XX
XX(*  from uToolIntf  *)
XX
XX
XX  (*for TextEdit*)
XX
XX  TERec = Record
XX    destRect: Rect;      (*Destination rectangle*)
XX    viewRect: Rect;      (*view rectangle*)
XX    selRect: Rect;      (*Select rectangle*)
XX    lineHeight: Integer;     (*Current font lineheight*)
XX    fontAscent: Integer;     (*Current font ascent*)
XX    selPoint: Point;      (*Selection point(mouseLoc)*)
XX
XX    selStart: Integer;      (*Selection start*)
XX    selEnd: Integer;      (*Selection end*)
XX
XX    active: Integer;      (*<>0 if active*)
XX
XX    wordBreak:  ProcPtr;     (*Word break routine*)
XX    clikLoop:  ProcPtr;      (*Click loop routine*)
XX
XX    clickTime: LONGINT;      (*Time of first click*)
XX    clickLoc: Integer;      (*Char. location of click*)
XX
XX    caretTime: LONGINT;      (*Time for next caret blink*)
XX    caretState: Integer;     (*On/active booleans*)
XX
XX    just: Integer;      (*fill style*)
XX
XX    TELength: Integer;      (*Length of text below*)
XX    hText: Handle;      (*Handle to actual text*)
XX
XX    recalBack: Integer;      (*<>0 if recal in background*)
XX    recalLines: Integer;     (*Line being recal'ed*)
XX    clikStuff: Integer;      (*click stuff (internal)*)
XX
XX    crOnly: Integer;      (*Set to -1 if CR line breaks only*)
XX
XX    txFont: Integer;      (*Text Font*)
XX    txFace: Style;      (*Text Face*)
XX    txMode: Integer;      (*Text Mode*)
XX    txSize: Integer;      (*Text Size*)
XX
XX    inPort: GrafPtr;      (*Grafport*)
XX
XX    highHook: ProcPtr;      (*Highlighting hook*)
XX    caretHook: ProcPtr;      (*Highlighting hook*)
XX
XX    nLines: Integer;      (*Number of lines*)
XX    lineStarts: Integer[16000];     (*Actual line starts themselves*)
XX  END; (*Record*)
XX
XX  TEPtr = ^TERec;
XX  TEHandle = ^TEPtr;
XX
XX
XX  (*for Resource Manager*)
XX
XX  ResType = Longint; (* Packed Array of 4 Chars *)
XX
XX
XX  (*for Control Manager*)
XX
XX
XX  ControlHandle    = ^LongInt;
XX
XX  (*for Dialog Manager*)
XX
XX  DialogPtr=    ^LongInt;
XX
XX
XX  (*for Menu Manager*)
XX
XX  MenuHandle = ^LongInt;
XX
XX
XX(*  from uOSIntf  *)
XX
XX  (*for Event Manager*)
XX  EventRecord = Record
XX    what:      Integer;
XX    message:   LongInt;
XX    when:      LongInt;
XX    where:     Point;
XX    modifiers: Integer;
XX  End;
XX
XX  OSErr = Integer;
XX
XX
XX  QElemPtr = ^LongInt;
XX
XX
XXIOParam = Record
XX   ioRefNum: Integer;       (*refNum for I/O operation*)
XX   ioVersNum: SignedByte;   (*version number*)
XX   ioPermssn: SignedByte;   (*Open: permissions (byte)*)
XX
XX   ioMisc: Ptr;      (*Rename: new name*)
XX                            (*GetEOF,SetEOF: logical End of file*)
XX                            (*Open: optional ptr to buffer*)
XX                            (*SetFileType: new type*)
XX   ioBuffer: Ptr;           (*data buffer Ptr*)
XX   ioReqCount: LongInt;     (*requested byte count*)
XX   ioActCount: LongInt;     (*actual byte count completed*)
XX   ioPosMode: Integer;      (*initial file positioning*)
XX   ioPosOffset: LongInt ;   (*file position offset*)
XXEnd;
XX
XX  OSType = Longint; (* Packed array of 4 chars *)
XX
XX  FInfo = Record      (*Record of finder info*)
XX            fdType: OSType;         (*the type of the file*)
XX            fdCreator: OSType;      (*file's creator*)
XX            fdFlags: Byte;       (*flags ex. hasbundle,invisible,locked, etc.*)
XX            filler: Byte;
XX            fdLocation: Point;      (*file's location in folder*)
XX            fdFldr: Integer;        (*folder containing file*)
XX          End; (*FInfo*)
XX
XXFileParam = Record
XX   ioFRefNum: Integer;      (*reference number*)
XX   ioFVersNum: SignedByte;  (*version number*)
XX   filler1: SignedByte;
XX   ioFDirIndex: Integer;    (*GetFileInfo directory index*)
XX   ioFlAttrib: SignedByte;  (*GetFileInfo: in-use bit=7, lock bit=0*)
XX   ioFlVersNum: SignedByte; (*file version number*)
XX   ioFlFndrInfo: FInfo;     (*user info*)
XX   ioFlNum: LongInt;        (*GetFileInfo: file number*)
XX   ioFlStBlk: Integer;      (*start file block (0 if none)*)
XX   ioFlLgLen: LongInt;      (*logical length (EOF)*)
XX   ioFlPyLen: LongInt;      (*physical lenght*)
XX   ioFlRStBlk: Integer;     (*start block rsrc fork*)
XX   ioFlRLgLen: LongInt;     (*file logical length rsrc fork*)
XX   ioFlRPyLen: LongInt;     (*file physical length rsrc fork*)
XX   ioFlCrDat: LongInt;      (*file creation date & time (32 bits in secs)*)
XX   ioFlMdDat: LongInt ;     (*last modified date and time*)
XXEnd;
XX
XXVolumeParam = Record
XX   filler2: LongInt;
XX   ioVolIndex: Integer;     (*volume index number*)
XX   ioVCrDate: LongInt;      (*creation date and time*)
XX   ioVLsBkUp: LongInt;      (*last backup date and time*)
XX   ioVAtrb: Integer;        (*volume attrib*)
XX   ioVNmFls: Integer;       (*number of files in directory*)
XX   ioVDirSt: Integer;       (*start block of file directory*)
XX   ioVBlLn: Integer;        (*GetVolInfo: length of dir in blocks*)
XX   ioVNmAlBlks: Integer;    (*GetVolInfo: num blks (of alloc size)*)
XX   ioVAlBlkSiz: LongInt;    (*GetVolInfo: alloc blk byte size*)
XX   ioVClpSiz: LongInt;      (*GetVolInfo: bytes to allocate at a time*)
XX   ioAlBlSt: Integer;       (*starting disk(512-byte) block in block map*)
XX   ioVNxtFNum: LongInt;     (*GetVolInfo: next free file number*)
XX   ioVFrBlk: Integer ;      (*GetVolInfo: # free alloc blks for this vol*)
XXEnd;
XX
XX
XXCntrlParam = Record
XX  ioCRefNum: Integer;       (*refNum for I/O operation*)
XX  CSCode: Integer;          (*word for control status code*)
XX  CSParam: Integer[10];     (*operation-defined parameters*)
XXEnd;
XX
XX  ParamBlockRec = Record
XX
XX        (*12 byte header used by the file and IO system*)
XX        qLink: QElemPtr;     (*queue link in header*)
XX        qType: Integer;      (*type byte for safety check*)
XX        ioTrap: Integer;     (*FS: the Trap*)
XX        ioCmdAddr: Ptr;      (*FS: address to dispatch to*)
XX
XX        (*common header to all variants*)
XX        ioCompletion: ProcPtr;  (*completion routine addr (0 for synch calls)*)
XX        ioResult: OSErr;        (*result code*)
XX        ioNamePtr: StringPtr;   (*ptr to Vol:FileName string*)
XX        ioVRefNum: Integer;     (*volume refnum (DrvNum for Eject and MountVol)*)
XX
XX        (*different components for the different type of parameter blocks*)
XX
XX        Variant
XX          Insert ioParam;
XX          Insert FileParam;
XX          Insert VolumeParam;
XX          Insert CntrlParam;
XX
XX      End; (*ParamBlockRec*)
XX
XX(*  from uPackIntf *)
XX
XX   SFReply = Record
XX     good: BOOLEAN;  (*ignore command if FALSE*)
XX     copy: BOOLEAN;  (*not used*)
XX     fType: OsType;  (*file type or not used*)
XX     vRefNum: Integer;  (*volume reference number*)
XX     version: Integer;  (*file's version number*)
XX     fName: Byte[64];  (*file name*)
XX   END; (*SFReply*)
XX
XX
XXprocedure z_z_z();{};
SHAR_EOF
if test 8926 -ne "`wc -c uGrep.src`"
then
echo shar: error transmitting uGrep.src '(should have been 8926 characters)'
fi
echo shar: extracting GrepPatStuff.src '(13365 characters)'
sed 's/^XX//' << \SHAR_EOF > GrepPatStuff.src
XXProgram GrepPatStuff;
XX
XX(*
XX    GrepPatStuff - routines for compiling patterns into internal form,
XX    for matching strings against the compiled pattern, and for presenting
XX    the pattern entry dialog.
XX*)
XX
XX
XXUses
XX    __ToolTraps
XX    (*$U+*)
XX    uGrep
XX    ;
XX
XXConst
XX
XX    bufSiz = 512;
XX
XX(*  pattern dialog items  *)
XX
XX    okButton = 1;
XX    cancelButton = 2;
XX    (* prompt statText = 3 *)
XX    patText = 4;
XX    linesRadioButton = 5;
XX    noLinesRadioButton = 6;
XX    numbersCheckBox = 7;
XX
XX(*  pattern special internal chars  *)
XX
XX    CCL = 1;           (* match characters in class *)
XX    NCCL = 2;          (* all but characters in class *)
XX    CRANGE = 3;        (* range of chars *)
XX    ENDCCL = 4;        (* end char class *)
XX    ANY = 5;           (* match any char *)
XX    CLOSURE = 6;       (* closure *)
XX    EOL = 7;           (* end of line *)
XX
XX
XXVar
XX    theDialog:  DialogPtr;
XX
XX(*  pattern compilation and matching vars  *)
XX
XX    rawPattern: Byte[bufSiz];   (* pattern user types in *)
XX    thePattern: Byte[bufSiz];   (* compiled pattern *)
XX
XX    matchBol: boolean;          (* match beginning of line? *)
XX    pix: integer;               (* index into pattern *)
XX    pMark: integer;
XX    canClose: boolean;
XX
XXExtDef  (* externals from main program *)
XX
XX    resBase:    Integer;    (* base resource id *)
XX    matchType:  Boolean;    (* true: print lines w/pattern. false: inverse *)
XX    prtLineNum: Boolean;    (* print line numbers if true *)
XX    havePat:    Boolean;    (* whether have good pattern or not *)
XX    lineNum:    LongInt;
XX
XX(*
XX    PToCStr - convert Pascal string to C string, in place
XX    CToPStr - convert C string to Pascal string, in place
XX
XX    These are here because this program was originally written in C
XX    and it was easier simply to convert the strings to work with the
XX    same algorithm, than to convert the algorithm to work with Pascal
XX    strings.
XX*)
XX
XXProc PToCStr (s: ptrb);
XXvar
XX    i, len: integer;
XX{
XX    len := s[0];
XX    loop (len > 0, i := 0, ++i, i >= len)   (* move contents down one *)
XX        s[i] := s[i+1];
XX    s[len] := 0;        (* add terminating null byte *)
XX};
XX
XXProc CToPStr (s: ptrb);
XXvar
XX    i, len: integer;
XX{
XX    loop (, len := 0, ++len, )    (* determine length of string *)
XX        if s[len] = 0 then break;
XX    loop (len > 0, i := len, --i, i < 1)    (* move contents up one *)
XX        s[i] := s[i-1];
XX    s[0] := len;        (* set length byte *)
XX};
XX
XX
XX
XX(* ----------------------------------------------------------------------- *)
XX(*                        pattern-compilation routines                     *)
XX(* ----------------------------------------------------------------------- *)
XX
XX(*
XX    ADD - add char to pattern (may be a metachar, not necessarily
XX        a literal character to match)
XX*)
XX
XXProc add (c: byte);
XX{
XX    thePattern[pix] := c;
XX    ++pix;
XX    thePattern[pix] := 0;
XX
XX};    (* add *)
XX
XX(*
XX    Put a closure indicator into the pattern, in front of the
XX    stuff that's to be closed.
XX*)
XX
XXProc addclose ();
XXvar
XX    i: integer;
XX{
XX    ++pix;
XX    loop (, i := pix, (*--i*), --i <= pMark)
XX        thePattern [i] := thePattern [i-1];
XX    thePattern [pMark] := CLOSURE;
XX    canClose := false;
XX
XX};    (* addclose *)
XX
XX(*
XX    have found something that may be followed by a closure.  set
XX    canClose to indicate that fact, and set a mark to remember where
XX    the closable thing is.
XX*)
XX
XXProc markit ();
XX{
XX    pMark := pix;        (* set mark in case closure comes up next *)
XX    canClose := true;
XX};
XX
XX(*
XX    compile character class.  pass pointer to char after '[' that begins
XX    the class pattern.  Return nil if error, else pointer to char
XX    after closing ']' bracket.
XX*)
XX
XXFunc Class (p: ptrb): ptrb;
XXvar
XX    c, type, low, high: byte;
XX{
XX    Class := nil;
XX    type := CCL;            (* 'character class' metachar *)
XX    if p^ = '^' then
XX    {
XX        type := NCCL;       (* 'match all but this class' metachar *)
XX        ++p;
XX    };
XX    add (type);
XX    loop (,,,)
XX    {
XX        c := p^;
XX        ++p;
XX        if c = ']' then break;          (* end of class pattern *)
XX        if c = 0 then return;           (* missing ']' - pattern error *)
XX        if p^ <> '-' then
XX            add (c)
XX        else        (* range *)
XX        {
XX            low := c;                   (* low end *)
XX            ++p;
XX            high := p^;                 (* high end *)
XX            ++p;
XX            if high = 0 then return;    (* pattern error *)
XX            add (byte (CRANGE));
XX            add (low);
XX            add (high);
XX        };
XX    };
XX    add (byte (ENDCCL));
XX    Class := p;    (* all ok *)
XX
XX};    (* class *)
XX
XX(*
XX    COMPILE - compile string into internal form suitable for efficient
XX        pattern matching.  String should be in C format.
XX*)
XX
XXFunc Compile (p: ptrb): boolean;
XXvar
XX    c: byte;
XX{
XX    Compile := false;
XX    pix := 0;
XX    thePattern[0] := 0;
XX    canClose := false;
XX    matchBol := false;
XX(*
XX    check for ^ - it's only special at beginning of line
XX*)
XX    if p^ = '^' then
XX    {
XX        matchBol := true;
XX        ++p;
XX    };
XX    loop (,,,)
XX    {
XX        c := p^;
XX        ++p;
XX
XX        if c = '*' then
XX        {
XX(*
XX    if canClose is true, there was a preceding pattern which can be
XX    closed (not closure, ^ or $), so close it.  otherwise, take *
XX    literally.
XX*)
XX            if canClose then    (* something to close *)
XX            {
XX                addclose ();
XX                continue;
XX            };
XX        };
XX
XX        if (c = '$') and (p^ = 0) then
XX(*
XX    $ only special at end of line
XX*)
XX        {
XX            add (byte (EOL));
XX            continue;
XX        };
XX(*
XX    at this point we know we have a character that can be followed by a
XX    closure, so mark the pattern position.
XX*)
XX        markit ();
XX        if c = '\\' then
XX        {
XX(*
XX    use escaped chars literally, except null, which is an error
XX*)
XX            if p^ = 0 then return;      (* pattern error *)
XX            add (p^);
XX            ++p;
XX            continue;
XX        };
XX        if c = 0 then break;            (* done compiling *)
XX        case integer(c) of
XX            '.': add (byte (ANY));      (* match any char *)
XX            '[':                        (* match character class *)
XX            {
XX                p := class (p);
XX                if p = nil then return; (* class pattern error *)
XX            };
XX            otherwise add (c);          (* match char literally *)
XX        end;
XX
XX    };  (* loop *)
XX
XX    Compile := true;    (* all ok *)
XX
XX};    (* compile *)
XX
XX(* ----------------------------------------------------------------------- *)
XX(*                         pattern-matching routines                       *)
XX(* ----------------------------------------------------------------------- *)
XX
XX(*
XX    NEXTPOS - find position in pattern of next component to match
XX*)
XX
XXFunc NextPos (p: ptrb): ptrb;
XXvar
XX    c: byte;
XX{
XX    c := p^;
XX    ++p;
XX    if (c = CCL) or (c = NCCL) then
XX    {
XX        loop (,,, c = ENDCCL)        (* look for end of class stuff *)
XX        {
XX            c := p^;
XX            ++p;
XX        };
XX    };
XX    NextPos := p;
XX
XX};    (* nextpos *)
XX
XXFunc InClass (c: byte; p: ptrb): Boolean;
XXvar
XX    high, low, pc: byte;
XX{
XX    InClass := false;
XX    loop (,,,)
XX    {
XX        pc := p^;
XX        ++p;
XX        if pc = ENDCCL then return;
XX        if pc = CRANGE then     (* range *)
XX        {
XX            low := p^;
XX            ++p;
XX            high := p^;
XX            ++p;
XX            if (low <= c) and (c <= high) then
XX                break;          (* it's within the range *)
XX        }
XX        else if c = pc then
XX            break;              (* it matched this char of class *)
XX    };
XX    InClass := true;
XX
XX};    (* inclass *)
XX
XX(*
XX    OMATCH - match character c against the current pattern position.
XX*)
XX
XXFunc omatch (c: byte; p: ptrb): boolean;
XXvar
XX    pc: byte;
XX{
XX    pc := p^;
XX    ++p;
XX    case integer(pc) of
XX        CCL: return (inclass (c, p));
XX        NCCL: return (!inclass (c, p));
XX        ANY: return (boolean (c <> 0)); (* don't match end of line *)
XX        otherwise return (boolean (c = pc));
XX    end;
XX
XX};    (* omatch *)
XX
XX(*
XX    try to match pattern p at the given position in string s
XX*)
XX
XXFunc amatch (s, p: ptrb): boolean;
XXvar
XX    c: byte;
XX    cursp: ptrb;
XX{
XX    if p^ = 0 then return (true);    (* end of pattern, have matched it *)
XX    if p^ = EOL then
XX        return (boolean (s^ = 0));    (* must be end of string to match EOL *)
XX
XX    if p^ = CLOSURE then
XX    {
XX(*
XX    advance as far as possible, matching the current pattern position.
XX    when omatch fails, s will point 1 past the character that failed.
XX    back up one and try to match rest of pattern.  if that fails, keep
XX    retreating until back at point of original closure start.
XX*)
XX        ++p;        (* skip closure marker *)
XX        cursp := s;    (* save current string position *)
XX        loop (,, c := s^; ++s, omatch (c, p) = false)
XX            ;
XX        loop (,,, s <= cursp)    (* keep backing up *)
XX        {
XX            --s;
XX            if amatch (s, nextpos (p)) then return (true);
XX        };
XX        return (false);
XX    };
XX    c := s^;
XX    ++s;
XX    if omatch (c, p) then
XX        return (amatch (s, nextpos (p)));
XX    amatch := false;
XX
XX};    (* amatch *)
XX
XX(*
XX    MATCH - match string s against the compiled pattern
XX
XX    if matchBol is true, then anchor the match to the beginning of the
XX    string, else try the pattern against successive string positions until
XX    the match succeeds or the end of the string is reached.
XX
XX    s should be in C format.
XX*)
XX
XXFunc match (s: PtrB): boolean;
XX{
XX    if matchBol then    (* anchored match *)
XX    {
XX        return (amatch (s, thePattern));
XX    };
XX    loop (,,,)          (* floating match *)
XX    {
XX        if amatch (s, thePattern) then return (true);
XX        if s^ = 0 then return (false);  (* end of string but no match *)
XX        ++s;
XX    };
XX
XX};    (* match *)
XX
XX
XX(* ----------------------------------------------------------------------- *)
XX(*                 Display dialog box to get the pattern                   *)
XX(* ----------------------------------------------------------------------- *)
XX
XX(*
XX    item    type
XX    1       ok button
XX    2       cancel button
XX    3       prompt
XX    4       edittext item for typing in pattern
XX    5       "lines containing pattern" radio button
XX    6       "lines not containing pattern" radio button
XX    7       "print line numbers" check box
XX
XX    Puts the string entered into theString, which on return is
XX    empty if either the user clicked cancel or typed no string
XX    and clicked ok.
XX*)
XX
XXProcedure SetValue (itemNo: Integer; itemValue: Boolean);
XXvar
XX    itemHandle: Handle;
XX    itemType: Integer;
XX    rect: Rect;
XX{
XX    GetDItem (theDialog, itemNo, @itemType, @itemHandle, rect);
XX(*
XX    Note type conversion here.  True turns the control on.
XX*)
XX    SetCtlValue (itemHandle, Integer (itemValue));
XX};
XX
XXFunction GetValue (itemNo: integer): Boolean;
XXvar
XX    itemHandle: Handle;
XX    itemType: integer;
XX    rect: Rect;
XX{
XX    GetDItem (theDialog, itemNo, @itemType, @itemHandle, rect);
XX(*
XX    Note implicit type conversion here.  Any non-zero is true.
XX*)
XX    GetValue := GetCtlValue (itemhandle);
XX};
XX
XX(*
XX    Set the type of line to select.  Pass the value for the "Match lines
XX    containing pattern" button.
XX*)
XX
XXProc SetMatchType (withval: Boolean);
XX{
XX    SetValue (linesRadioButton, withval);
XX    SetValue (noLinesRadioButton, !withval);
XX};
XX
XX
XXFunc GetPatDlog (): Boolean;
XXVar
XX    itemNo, itemType: Integer;
XX    itemHandle: Handle;
XX    rect: Rect;
XX{
XX    GetPatDlog := false;
XX    theDialog := GetNewDialog (resBase, nil, -1L);
XX    SetMatchType (matchType);
XX    SetValue (numbersCheckBox, prtLineNum);
XX    GetDItem (theDialog, patText, @itemType, @itemHandle, rect);
XX    SetIText (itemHandle, rawPattern);
XX    SelIText (theDialog, patText, 0, 32760);
XX    ShowWindow (theDialog);
XX    loop (,,,)
XX    {
XX        ModalDialog (nil, @itemNo);
XX        case itemNo of
XX            okButton:
XX            {
XX                GetDItem (theDialog, patText, @itemType, @itemHandle, rect);
XX                GetIText (itemHandle, rawPattern);
XX                matchType := GetValue (linesRadioButton);
XX                prtLineNum := GetValue (numbersCheckBox);
XX                GetPatDlog := true;
XX                break;
XX            };
XX            cancelButton: break;
XX            linesRadioButton: SetMatchType (true);
XX            noLinesRadioButton: SetMatchType (false);
XX            numbersCheckBox:
XX                SetValue (numbersCheckBox, !GetValue (numbersCheckBox));
XX        end;
XX    };
XX    DisposDialog (theDialog);
XX
XX};    (* GetPatDlog *)
XX
XX
XXProc GetGrepPat ();
XX{
XX    if GetPatDlog () then
XX    {
XX        PToCStr (rawPattern);
XX        havePat := Compile (rawPattern);
XX        CtoPStr (rawPattern);
XX        if !havePat then
XX            Alarm ("Bad Pattern");
XX    };
XX};
XX
XX
XX(* ----------------------------------------------------------------------- *)
XX(*                         Pattern Initialization                          *)
XX(* ----------------------------------------------------------------------- *)
XX
XX(*
XX    Set pattern initially to empty pattern.  This is legal - it matches
XX    every line.  If a file is grepped without specifying a pattern, therefore,
XX    the whole file will be displayed.  A side effect of this is to turn
XX    grep on WORD files into a WORD-to-TEXT file converter, when the save
XX    output option is turned on.
XX*)
XX
XXProc InitPat ();
XX{
XX    rawPattern[0] := 0;
XX    havePat := Compile (rawPattern);
XX};
SHAR_EOF
if test 13365 -ne "`wc -c GrepPatStuff.src`"
then
echo shar: error transmitting GrepPatStuff.src '(should have been 13365 characters)'
fi
echo shar: extracting Grep-Wc.src '(14893 characters)'
sed 's/^XX//' << \SHAR_EOF > Grep-Wc.src
XXProgram Grep_Wc;
XX
XX(*
XX    Grep - Globally search for Regular Expressions and Print, i.e.,
XX        g/r.e./p
XX
XX    Wc - char, word, line/paragraph count
XX
XX    Special characters for patterns
XX
XX    ^       Match beginning of line (if at beginning of pattern)
XX    $       Match end of line (if at end of pattern)
XX    .       Match any character
XX    [..]    Match class of characters.  If first character following
XX            the [ is ^, match all BUT the range of characters.  A range
XX            of characters may be specified by separating them with a
XX            dash, e.g., [a-z].  The dash itself may be included as a class
XX            member by giving it as the first class char (e.g., [-a-z]).
XX    *       Match any number of preceding things (if does not follow
XX            *, ^ or $)
XX
XX    characters which have special meanings only in certain places in
XX    the pattern do not have that meaning elsewhere.  Special meaning
XX    may be turned off otherwise (except within a class) by escaping
XX    it with '\'.  The backslash may be entered into a pattern by
XX    doubling it.
XX
XX    Version 1.0     12 March 1986
XX
XX    Paul DuBois
XX    Wisconsin Regional Primate Research Center
XX    1220 Capitol Court
XX    University of Wisconsin-Madison
XX    Madison, WI  53706
XX
XX    UUCP: {allegra, ihnp4, seismo}!uwvax!uwmacc!dubois
XX*)
XX
XX
XXUses
XX    GrepPatStuff    (* pattern compilation and matching routines *)
XX    __StreamLib
XX    __DeskLib
XX    __ToolTraps
XX    __QuickDraw
XX    __OSTraps
XX    (*$U+*)
XX    uGrep   (* global constants, types, and variables *)
XX    ;
XX
XXLink
XX    GrepPatStuff
XX    __StreamLib
XX    __DeskLib
XX    __OSTraps
XX    : ;
XX
XX
XXConst
XX
XX    bufSiz = 512;
XX    curApplName = $910L;        (* location of name of current application *)
XX    defaultResID = -15552;      (* DRVR 26 base id *)
XX
XX
XX(*  menu item numbers  *)
XX
XX    itemAbout = 1;
XX    (* --- *)
XX    itemCount = 3;
XX    itemSearch = 4;
XX    itemPattern = 5;
XX    itemOutput = 6;
XX
XXVar
XX(*
XX    For a good time, declare thePort: WindowPtr (=GrafPtr!) and try to compile.
XX    Then look in uToolIntf under WindowPtr and sprout question marks.
XX*)
XX    thePort:    GrafPtr;
XX    teHand:     TEHandle;
XX    streamInfo: SFReply;
XX    theMenu:    MenuHandle;
XX    theMenuID:  Integer;
XX    resBase:    Integer;    (* base resource id *)
XX    matchType:  Boolean;    (* true: print lines w/pattern. false: inverse *)
XX    prtLineNum: Boolean;    (* print line numbers if true *)
XX    havePat:    Boolean;    (* whether have good pattern or not *)
XX    lineNum:    LongInt;
XX    paused:     Boolean;
XX    fileOpen:   Boolean;
XX    outFile:    Integer;
XX    outReply:   SFReply;
XX
XX    pauseCtl:   ControlHandle;
XX    cancelCtl:  ControlHandle;
XX    grepping:   Boolean;
XX
XX
XX
XXProc GrepState (val: Integer);
XX{
XX    HiliteControl (pauseCtl, val);
XX    HiliteControl (cancelCtl, val);
XX    grepping := !Boolean (val);
XX};
XX
XX
XX(*
XX    Cancel any current grep operation.
XX    Must not be called before InitStream.
XX*)
XX
XXProc StopGrep ();
XX{
XX    if grepping then
XX    {
XX        CloseStream ();
XX        GrepState (255);
XX    };
XX};
XX
XX
XXProc DrawStuff ();
XX{
XX    DrawControls (thePort);
XX    MoveTo (0, 24);
XX    LineTo (1000, 24);
XX    TEUpdate (teHand^^.viewRect, tehand);
XX};
XX
XX
XX
XXProc Alarm (mesg: PtrB);
XXVar
XX    result: Integer;
XX{
XX    ParamText (mesg, "", "", "");
XX    result := Alert (resBase+2, nil);
XX};
XX
XX
XXProc FileOutput ();
XXVar
XX    f: FInfo;
XX    result: OSErr;
XX    s: PtrB;
XX    p: ParamBlockRec;
XX    ok: Boolean;
XX{
XX    s := nil;
XX    if fileOpen then    (* close it *)
XX    {
XX        fileOpen := false;
XX        p.ioRefNum := outFile;
XX        result := PBGetFPos (p, false);
XX        p.ioMisc := p.ioPosOffset;
XX        result := PBSetEOF (p, false);
XX        result := FSClose (outFile);
XX        s := "Save Output...";
XX    }
XX    else
XX    {
XX        if EqualString ("Finder", curApplName, false, true) then
XX        {
XX            Alarm ("Not In Finder");
XX            return;
XX        };
XX        Toolbox($A9EA, 100, 70, "Write To...", "", nil, @outReply, 1);
XX        if outReply.good then
XX        {
XX            if GetFInfo (outReply.fName, outReply.vRefNum, @f) = noErr then  (* exists *)
XX            {
XX                if f.fdType <> PtrL (" TEXT"+2)^ then
XX                {
XX                    Alarm ("Not A TEXT File");
XX                    return;
XX                };
XX            }
XX            else    (* doesn't exist.  create it. *)
XX            {
XX                if Create (outReply.fName, outReply.vRefNum, PtrL (" Grep"+2)^,
XX                    PtrL (" TEXT"+2)^) <> noErr then
XX                {
XX                    Alarm ("Can't Create");
XX                    return;
XX                };
XX            };
XX            if _FSOpen (outReply.fName, outReply.vRefNum, @outFile, fsWrPerm)
XX                    <> noErr
XX                then Alarm ("Can't Open")
XX            else
XX            {
XX                fileOpen := true;
XX                s := "Stop Saving Output";
XX            };
XX        };
XX    };
XX    if s <> nil then
XX        SetItem (theMenu, itemOutPut, s);
XX};
XX
XX(*
XX    Add string to display area.  First insert it at the end.  Test if
XX    must scroll lines off top to get the new stuff to show up.  If yes,
XX    then do the scroll.  To keep from filling up the TERec, delete
XX    whatever got scrolled out of view every once in a while.  (The number
XX    of lines scrolled off the top to check for is arbitrary - I clobber
XX    stuff after every 25 lines.)  To avoid unnecessary redrawing, set to
XX    no clip before doing the delete (which would redraw) and the scroll
XX    back down (which would also redraw).
XX
XX    Also write string to output file if one is open.
XX*)
XX
XXProc DisplayString (theStr: PtrB);
XXVar
XX    dispLines: Integer;     (* number of lines displayable in window *)
XX    topLines: Integer;      (* number of lines currently scrolled off top *)
XX    scrollLines: Integer;   (* number of lines to scroll up *)
XX    height: Integer;
XX    r: Rect;
XX    len: LongInt;
XX{
XX    len := theStr[0];
XX    height := teHand^^.lineHeight;
XX    TESetSelect (32760L, 32760L, teHand); (* set to insert at end *)
XX    TEInsert (theStr+1, len, teHand);
XX    r := teHand^^.viewRect;
XX    dispLines := (r.bottom - r.top) / height;
XX    topLines := (r.top-teHand^^.destRect.top) / height;
XX    scrollLines := teHand^^.nLines - topLines - dispLines;
XX    if scrollLines > 0 then (* must scroll up *)
XX    {
XX        TEScroll (0, Integer (-height * scrollLines), teHand); (* scroll up *)
XX        topLines += scrollLines;
XX        if topLines > 25 then    (* keep TERec from filling up *)
XX        {
XX(*
XX    now clobber first line(s), and scroll back down to resync what will
XX    then be the first line.  Set clipping empty, so that the redraw from the
XX    delete and the scroll down will not be shown.
XX*)
XX            SetRect (r, 0, 0, 0, 0);
XX            ClipRect (r);
XX            TESetSelect (0L, LongInt (teHand^^.lineStarts[topLines]), teHand);
XX            TEDelete (teHand);
XX            TEScroll (0, Integer (height * topLines), teHand);
XX            ClipRect (thePort^.portRect);
XX        };
XX    };
XX    if fileOpen then
XX    {
XX        if FSWrite (outFile, @len, theStr+1) <> noErr then
XX        {
XX            Alarm ("Write Error (Closing File)");
XX            FileOutput ();
XX        };
XX    };
XX};
XX
XX
XXProc DisplayLn ();
XX{
XX    DisplayString ("\r");
XX};
XX
XX
XXProc DisplayLong (long: LongInt);
XXVar
XX    str: Byte[18];
XX    s: PtrB;
XX{
XX    s := str;
XX    RegCall (Trap $A9EE, s, , long, 0);     (* NumToString *)
XX    DisplayString (str);
XX};
XX
XX
XX
XXFunc GetStream (): Boolean;
XXVar
XX    s: Byte[5];
XX    i: Integer;
XX{
XX    GetStream := false;
XX    if OpenStream () = noErr then
XX    {
XX        GetStream := true;
XX        if thePort <> FrontWindow () then
XX            SelectWindow (thePort);
XX        GetStreamInfo (streamInfo);
XX        DisplayString (streamInfo.fName);
XX        DisplayString (" (");
XX        s[0] := 4;
XX        (*PtrL (@s[1])^ := streamInfo.fType;*)  (* doesn't work - odd addr! *)
XX        loop ( , i:=0, ++i, i > 3)
XX            s[i+1] := (PtrB (@streamInfo.fType))[i];
XX        DisplayString (s);
XX        DisplayString (" file)\r");
XX    };
XX    DrawStuff ();
XX};
XX
XX(*
XX    Display lines matching (or not matching) pattern.  This is called to
XX    get a line at a time from _Main.  Mouse clicks in _Mouse control the
XX    state of the pause variable.
XX*)
XX
XXProc GrepLine ();
XXVar
XX    buf: block[bufSiz];
XX{
XX    if !paused then
XX    {
XX        if StreamGetS (buf) = nil then
XX        {
XX            StopGrep ();
XX        }
XX        else
XX        {
XX            ++lineNum;
XX            PToCStr (buf);
XX            if match (buf) = matchType then
XX            {
XX                if prtLineNum then
XX                {
XX                    DisplayLong (lineNum);
XX                    DisplayString (": ");
XX                };
XX                CtoPStr (buf);
XX                DisplayString (buf);
XX                DisplayLn ();
XX            };
XX        };
XX    };
XX};
XX
XX
XX
XX(*
XX    Catch mouse down events, and interpret if window grow event.  This is
XX    difficult to test inside of Rascal, since it will catch mouse downs
XX    in the grow region and size the window itself.  Can't use FindWindow
XX    in _Event when running as a DA, since it returns inSysWindow for a
XX    part code, not inGrow!
XX*)
XX
XXProc _MOUSE (x, y: Integer);
XXVar
XX    ctl: ControlHandle;
XX    thePt: Point;
XX    r: Rect;
XX{
XX    thePt.h := x;
XX    thePt.v := y;
XX    r := thePort^.portRect; (* see the mouse was pressed in grow region *)
XX    r.left := r.right - 15;
XX    r.top := r.bottom - 15;
XX    if PtInRect (thePt.vh, r) then
XX    {
XX        LocalToGlobal (@thePt);
XX        SetRect (r, 170, 60, 512, 342);
XX        thePt.vh := GrowWindow (thePort, thePt.vh, r);
XX        SizeWindow (thePort, thePt.h, thePt.v, true);
XX        r := thePort^.portRect;
XX        ClipRect (r);
XX(*
XX    Reset the text viewRect.  It's not necessary to reset the destRect,
XX    since only the top and left are used, and they haven't changed.
XX*)
XX        r.top += 25;
XX        r.left += 6;
XX        teHand^^.viewRect := r;
XX    }
XX    else if FindControl (thePt.vh, thePort, @ctl) then
XX    {
XX        if TrackControl (ctl, thePt.vh, nil) then
XX        {
XX            if ctl = cancelCtl then
XX            {
XX                StopGrep ();
XX            }
XX            else if ctl = pauseCtl then
XX            {
XX                if paused then
XX                    SetCTitle (pauseCtl, "Pause")
XX                else
XX                    SetCTitle (pauseCtl, "Resume");
XX                paused := !paused;
XX            };
XX        };
XX    };
XX};
XX
XX
XXProc Wc ();
XXVar
XX    lines, nonEmptyLines, words, chars: LongInt;
XX    inToken: Boolean;
XX    c, lastc: Integer;
XX{
XX    lines := 0;
XX    nonEmptyLines := 0;
XX    words := 0;
XX    chars := 0;
XX    inToken := false;
XX    loop (, lastc := '\r', lastc := c,)
XX    {
XX        c := StreamGetC ();
XX        if c = -1 then break;   (* eof *)
XX        ++chars;
XX        case c of
XX            '\r':
XX            {
XX                ++lines;
XX                if lastc <> '\r' then
XX                    ++nonEmptyLines;
XX                inToken := false;
XX            };
XX            ' ',
XX            '\t': inToken := false;
XX            otherwise
XX                if inToken = false then
XX                {
XX                    ++words;
XX                    inToken := true;
XX                };
XX        end;
XX    };
XX    if (lastc <> '\r') then    (* in case of missing cr on last line *)
XX    {
XX        ++lines;
XX        ++nonEmptyLines;
XX    };
XX    DisplayLong (chars);
XX    DisplayString (" Chars, ");
XX    DisplayLong (words);
XX    DisplayString (" Words, ");
XX    DisplayLong (lines);
XX    if streamInfo.fType = PtrL (" TEXT"+2)^ then
XX        DisplayString (" Lines")
XX    else
XX    {
XX        DisplayString (" Paragraphs (");
XX        DisplayLong (nonEmptyLines);
XX        DisplayString (" non-empty)");
XX    };
XX    DisplayLn ();
XX};
XX
XX
XXProc _INIT ();
XXVar
XX    r: Rect;
XX{
XX    GetPort(@thePort);
XX
XX(*  adapt to environment - am I a desk accessory or not?  *)
XX
XX    theMenuId := DAMenuInit ();
XX    resBase := defaultResID;
XX    if IsDARun () then
XX    {
XX        resBase := GetResIDBase ();
XX    };
XX
XX    theMenu := NewMenu (theMenuId, "Grep-Wc");
XX    InsertMenu (theMenu, 0);
XX    AppendMenu (theMenu,
XX    "About Grep-Wc;(-;Count...;Search...;Set Pattern...;Save Output...");
XX    DrawMenuBar ();
XX
XX    InitStream ();              (* set up for stream input *)
XX    InitPat ();                 (* initialize pattern *)
XX    fileOpen := false;          (* no output file currently *)
XX
XX(*  Initial option settings  *)
XX
XX    matchType := true;          (* print lines with pattern *)
XX    prtLineNum := false;        (* don't print line numbers *)
XX
XX(*  Create TERec and build controls  *)
XX
XX    r := thePort^.portRect;
XX    r.top += 25;            (* leave room for buttons *)
XX    r.left += 6;
XX    teHand := TENew (r, r);
XX    teHand^^.crOnly := -1;  (* no word wrap *)
XX    SetRect (r, 5, 2, 85, 22);
XX    pauseCtl :=
XX        NewControl (thePort, r, "Pause", true, 0, 0, 0, pushButProc, nil);
XX    OffSetRect (r, 90, 0);
XX    cancelCtl :=
XX        NewControl (thePort, r, "Cancel", true, 0, 0, 0, pushButProc, nil);
XX
XX    GrepState (255);    (* set grepping false, inactivate buttons *)
XX    DrawStuff ();
XX};
XX
XXProc _HALT ();
XX{
XX    CloseStream ();         (* close any open input file *)
XX    if fileOpen then        (* close output file if one is open *)
XX        FileOutPut ();
XX    KillControls (thePort); (* toss controls *)
XX    TEDispose (teHand);     (* toss text *)
XX    DeleteMenu (theMenuID); (* toss menu *)
XX    DisposeMenu (theMenu);
XX    DrawMenuBar ();
XX};
XX
XX
XXProc _UPDATE();
XX{
XX    DrawStuff ();
XX};
XX
XX
XXProc _MENU (id, item: Integer);
XX{
XX    case item of
XX        itemAbout:  item := Alert (resBase+1, nil);
XX        itemCount:
XX        {
XX            StopGrep ();        (* terminate any ongoing grep operation *)
XX            if GetStream () then
XX                Wc ();
XX        };
XX        itemSearch:
XX        {
XX            StopGrep ();        (* terminate any ongoing grep operation *)
XX            if !havePat then
XX                GetGrepPat ();
XX            if (* now *) havePat then
XX                if GetStream () then    (* do grep setup *)
XX                {
XX(*
XX    Don't comment this section out if you don't want the user
XX    to be able to grep his current output file.
XX                    if fileOpen then
XX                    {
XX                        if EqualString (outReply.fName, streamInfo.fName,
XX                                        false, true)
XX                        and (outReply.vRefNum = streamInfo.vRefNum) then
XX                        {
XX                            Alarm ("Can't Grep Output File");
XX                            return;
XX                        };
XX                    };
XX    end commenting out
XX*)
XX                    lineNum := 0;
XX                    paused := false;
XX                    SetCTitle (pauseCtl, "Pause");
XX                    GrepState (0);  (* turn controls on, grepping true *)
XX                };
XX        };
XX        itemPattern: GetGrepPat ();
XX        itemOutput: FileOutput ();
XX    end;
XX};
XX
XX
XXProc _MAIN ();
XX{
XX    if (thePort = FrontWindow ()) and grepping then GrepLine ();
XX};
SHAR_EOF
if test 14893 -ne "`wc -c Grep-Wc.src`"
then
echo shar: error transmitting Grep-Wc.src '(should have been 14893 characters)'
fi
echo shar: extracting Grep-Wc.rsrc.Hqx '(1535 characters)'
sed 's/^XX//' << \SHAR_EOF > Grep-Wc.rsrc.Hqx
XX(This file must be converted with BinHex 4.0)
XX
XX:$%GbCA!Y9f-ZFR0bB`"549K&8N008!#3#!422H%!N!3"!*!$!p%!!!,4!*!$IN(
XXX!J!J#0#I)%![#"!Z!!JJAa#!3H`%!P*3-#`%!NM!,`""l!)!)!M3Rb"!,`J`2!!
XX!)&m3J%jH)&rHr!!#6Y"19[rq3H`%!P*33HlrrLm)-#`%!L"I-)"J!!!H3HlrrP0
XX3-#`%"$m!-#lrrV"IAm"%!%S!CJ!!1M!Zrrj)`#m!3H`#!#!)d*mJ3#m)-$`!!6m
XX!-#lrrT!!AdM!,`""l!)!)!M3Rb"!%"!JAa#!B!$rVM!X"!4)`#m!3H`#!#!)d*m
XXJ3#m)-$`!"L"I%)""l!3',`J`2!!!)&m`J%jH6R9"l!3%,`J`,!3#)&m`J%(X"!B
XX!N!-9!#J!-J#L!E`!!3#3#-0!!*!%Y!!'!*!&3!%c!&3"E`3#6dX!N!9D!6-!EJ&
XX["!C$B@jMC@`!N!8'!!N!&`"$L!K3BA4dCA*Z1J#3"4d!#!!Y!AQ3!!#3"MN!"J"
XX0!0N''%aTEQ9c)%0[ER4KD@jTEQFJ8'&dG'9bEJ#3"8i!"J"L!0J'(%aTEQ9c)%j
XX[G#"$EfjdB@PZD@jR)&"KG(4PFQi!N!9M!!B!G`$B"3a-D@jP)%jeE@*PFR-!N!-
XX-!#`!%!$N!CE$384%!!!"RJ!%!*!&P!!b!+J!EJ3#6dX!N!8)!!F!KJ#BL(T(FQ9
XX`)#mJ9fpbC#"$Eh9ZG!ef-5i`)#!a-b"0BA*MD#!a16Jf$5K3G@*XD@-J4'pYB@P
XXZ+3d08'&eE#"%G8*[DA-0-6)b-#"$BA"TG'pX)%0[GA*d$8eKC'PcEfiJ9dNJ06-
XXh-$B0999$8$SJGAGYB@0M)@4eBQpTF`#3"4i![J#Z!0D)%&i0*!dZ$9XZ,Pd0$5S
XX0$9`!N!8H!0S!VJ'&L,"0BA4MD#"cG'&bG#"[CL"XD@jP$8eKG'0S)'9ZC#"[CL"
XXXD@jP$8eKG'0S)'&ZH5"MD'&bB@0dCA)06@&dBfJJB@jj)'0SBA*KBh4PFL"LCA4
XXhC@9Z)'*bB@0VCA4c$8eKG'0S)'&ZH5"ZG@eLCA)JEfBJG'KP)("bCACTEh9c)(4
XXSD@jR$94eFQiJEfCQ)(0`C@0TB@`JE@9KEQPZCb"[CL"ZCAKd)'0SBA*KBh4PFJ#
XX3"3J![J!D!A1)'P0`C@0TB@`J8'&dG'9bEL"$D'&bB@0dCA*cB@0dCA*cBQaTBb"
XXNEfeKD@iTG@*[DA-+!*!$)J!"!*!&8`"2!'F!L`3#6dX!N!8(!!B!4`#3!)J#AM!
XX!N!--!$)!0!#P!-M$3N4%!!!"!*!$!p%!!!,4!*!$IJ!!c"`!2J#3!a`!IJ!#4%P
XX86!!#!"T%6%p(!*!$2N&-8P3!!3"+`d,rrb!!!TX!N!6$3Irr)!!!i3!"-(,$32r
XXr)!!!'3#3"-0!rrmJ!*!(`d,rrb!!!X%!!5YS`d(rrb!!!0%!!5YXSC):
SHAR_EOF
if test 1535 -ne "`wc -c Grep-Wc.rsrc.Hqx`"
then
echo shar: error transmitting Grep-Wc.rsrc.Hqx '(should have been 1535 characters)'
fi
echo shar: extracting AddRes.src '(5070 characters)'
sed 's/^XX//' << \SHAR_EOF > AddRes.src
XXProgram AddRes;
XX
XXUses
XX    __ToolTraps
XX    __QuickDraw
XX    __OSTraps
XX    __DeskLib
XX    (*$U+*)
XX    uOSIntf
XX    uToolIntf
XX    uPackIntf
XX    ;
XX
XXLink
XX    __DeskLib
XX    __OSTraps
XX    __NoSysCall
XX    : ;
XX
XX
XXVar
XX    buttonTitle: PtrB;
XX
XX
XXProc PrintResType (resType: ResType);
XXVar
XX    i: Integer;
XX{
XX    loop (, i := 0, , ++i > 3)
XX    WriteChar (Integer (PtrB (@resType)[i]));
XX};
XX
XXProc CopyResources (srcResFile, dstResFile: Integer);
XXVar
XX    curRF: Integer;
XX    numTypes: Integer;
XX    numRes: Integer;
XX    resHand: Handle;
XX    resType: ResType;
XX    resId: Integer;
XX    resName: str255;
XX    i, j: Integer;
XX{
XX    WriteString ("Source, dest files ");
XX    WriteInt (srcResFile);
XX    WriteInt (dstResFile);
XX    WriteLn ();
XX    numTypes := CountTypes ();
XX    SetResFileAttrs (srcResFile, 128);  (* source map read only *)
XX    SetResPurge (true);
XX    loop (numTypes > 0, i := numTypes, , --i < 1)
XX    {
XX        GetIndType (@resType, i);   (* get name of resource type *)
XX        numRes := CountResources (resType);
XX        loop (numRes > 0, j := 1, , ++j > numRes)
XX        {
XX            curRF := CurResFile ();
XX            SetResLoad (false);
XX            resHand := GetIndResource (resType, j);
XX            SetResLoad (true);
XX            if HomeResFile (resHand) = srcResFile then
XX            {
XX                LoadResource (resHand);
XX                GetResInfo (resHand, @resId, @resType, resName);
XX                UseResFile (srcResFile);
XX                RmveResource (resHand);
XX                UseResFile (dstResFile);
XX                AddResource (resHand, resType, resId, resName);
XX                WriteString ("AddResource ");
XX                WriteInt (ResError());
XX                WriteLn ();
XX                HPurge (resHand);
XX                UseResFile (curRf);
XX                WriteString ("Added ");
XX                PrintResType (resType);
XX                WriteInt (resId);
XX                WriteChar (' ');
XX                WriteString (resName);
XX                WriteLn ();
XX            };
XX        };
XX    };
XX};
XX
XXFunction GFFilter (theItem: integer; theDialog: Ptrl): Integer; Clean;
XXvar
XX    itemNo: integer;
XX    itemType: integer;
XX    itemHandle: Handle;
XX    rect: Integer[4];
XX{
XX    DAClean (false);
XX    if theItem = -1 then    (* change name of "Open" button *)
XX    {
XX        GetDItem (theDialog, 1, @itemType, @itemHandle, rect);
XX        SetCTitle (itemHandle, buttonTitle);
XX    };
XX    GFFilter := theItem;
XX};
XX
XX
XXFunc GetFile(reply: ^SFReply; btnTitle: PtrB): Boolean;
XX{
XX    buttonTitle := btnTitle;
XX    Toolbox ($A9EA, 100, 50, " ", nil, -1, nil, GFFilter, reply, 2);
XX    GetFile := reply^.good;
XX};
XX
XXFunc myGetVol (): Integer;
XXVar
XX    p: ParamBlockRec;
XX    result: OSErr;
XX{
XX    p.ioCompletion := nil;
XX    p.ioNamePtr := nil;
XX    result := PBGetVol (p, false);
XX    myGetVol := p.ioVRefNum;
XX};
XX
XXProc mySetVol (v: Integer);
XXVar
XX    p: ParamBlockRec;
XX    result: OSErr;
XX{
XX    p.ioCompletion := nil;
XX    p.ioNamePtr := nil;
XX    p.ioVRefNum := v;
XX    result := PBSetVol (p, false);
XX};
XX
XX
XXFunc OpenResourceFile (name: PtrB; vRefNum: Integer): Integer;
XXVar
XX    curVol: Integer;
XX{
XX    curVol := myGetVol ();
XX    mySetVol (vRefNum);
XX    OpenResourceFile := OpenResFile (name);
XX    mySetVol (curVol);
XX};
XX
XX
XXProc CreateResourceFile (name: PtrB; vRefNum: Integer);
XXVar
XX    curVol: Integer;
XX{
XX    curVol := myGetVol ();
XX    mySetVol (vRefNum);
XX    CreateResFile (name);
XX    mySetVol (curVol);
XX};
XX
XX
XXProc _Init ();
XXVar
XX    srcResFile, dstResFile: Integer;
XX    srcReply, dstReply: SFReply;
XX    thePort: PtrL;
XX{
XX    DAClean (true);
XX    GetPort (@thePort);
XX    TextFont (0);
XX    TextSize (0);
XX    MoveWindow (thePort, 4, 235, false);
XX    SizeWindow (thePort, 504, 100, false);
XX    WriteString ("\nSelect the file you wish to copy resources FROM.\n");
XX    if GetFile (@srcReply, "Copy From") then
XX    {
XX        srcResFile := -1;
XX        WriteString ("Now select the file you wish to copy resources TO.\n");
XX        if GetFile (@dstReply, "Copy To") then
XX        {
XX            srcResFile := OpenResourceFile (srcReply.fName, srcReply.vRefNum);
XX            if srcResFile = -1 then
XX                WriteString ("Can't open input file.\n")
XX            else
XX            {
XX                dstResFile := OpenResourceFile (dstReply.fName,
XX                                                dstReply.vRefNum);
XX                if dstResFile = -1 then
XX                {
XX                    WriteString ("Creating resource fork - output file.\n");
XX                    CreateResourceFile (dstReply.fName, dstReply.vRefNum);
XX                    dstResFile := OpenResourceFile (dstReply.fName,
XX                                                      dstReply.vRefNum);
XX                    if dstResFile = -1 then
XX                        WriteString ("Couldn't create resource file.\n");
XX                };
XX                if dstResFile <> -1 then
XX                {
XX                    CopyResources (srcResFile, dstResFile);
XX                    CloseResFile (dstResFile);
XX                };
XX            };
XX        };
XX        if srcResFile <> -1 then
XX            CloseResFile (srcResFile);
XX    };
XX    ReqHalt ();
XX};
SHAR_EOF
if test 5070 -ne "`wc -c AddRes.src`"
then
echo shar: error transmitting AddRes.src '(should have been 5070 characters)'
fi
#    End of shell archive
exit 0