dubois@uwmacc.UUCP (Paul DuBois) (03/17/86)
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
--
|
Paul DuBois {allegra,ihnp4,seismo}!uwvax!uwmacc!dubois --+--
|
|