-- MTypeImpl.Mesa, last edit  February 8, 1983 4:46 pm
-- Pilot 6.0/ Mesa 7.0
-- main program for the mesa type program

DIRECTORY
  CWF: TYPE USING [SetWriteProcedure, WF0, WF1, WF2, WFCR],
  IO: TYPE USING[Handle, PutChar, UserAbort],
  Rope: TYPE USING[ROPE, Text],
  RopeInline: TYPE USING[InlineFlatten],
  UnsafeSTP: TYPE USING [Error],
  STPSubr: TYPE USING [PatternGeneralOpen, RetrieveProcType, StopSTP],
  String: TYPE USING [AppendChar, AppendString, UpperCase],
  Subr: TYPE USING [AbortMyself, debugflg, errorflg, GetLine, MakeTTYProcs,
  	strcpy, TTYProcs],
  UECP: TYPE USING[Argv, Parse],
  UserExec: TYPE USING[AcquireResource, AskUser, CommandProc, GetStreams, 
  	RegisterCommand, ReleaseResource];

MTypeImpl: PROGRAM 
IMPORTS CWF, IO, RopeInline, STP: UnsafeSTP, STPSubr, String, 
	Subr, UECP, UserExec = {

-- MDS usage!!
stdout: IO.Handle;
-- end of mds


Main: UserExec.CommandProc = TRUSTED {
	ENABLE UNWIND => [] _ UserExec.ReleaseResource[$MType];
	h: Subr.TTYProcs;
	in, out: IO.Handle;
	[in, out] _ UserExec.GetStreams[exec];
	[] _ UserExec.AcquireResource[$MType, "MType", exec];
	h _ Subr.MakeTTYProcs[in, out, exec, MyConfirm];
	MTypeUsingProcs[h, event.commandLine];
	[] _ UserExec.ReleaseResource[$MType];
	};

-- this is the procedure called by the Simple Executive

MTypeUsingProcs: PROC[h: Subr.TTYProcs, commandLine: Rope.ROPE] = {
ENABLE Subr.AbortMyself => {
	CWF.WF0["Aborted.\n"L];
	GOTO leave;
	};

newpattern: STRING _ [100];
Subr.errorflg _ Subr.debugflg _ FALSE;
stdout _ h.out;
[] _ CWF.SetWriteProcedure[MyPutChar];
[] _ InitMain[newpattern, h, commandLine];
CWF.WF0["\n**** MType finished.\n"L];
EXITS
leave => NULL;
};

InitMain: PROC[newpattern: STRING, h: Subr.TTYProcs, commandLine: Rope.ROPE]
	RETURNS[grepflag: BOOL] = {
token: STRING _ [100];
ignoreCaseFlag: BOOL _ FALSE ;
grepPattern:    STRING _ [100] ;
flat: Rope.Text;
argv: UECP.Argv _ UECP.Parse[commandLine];
parm: CARDINAL;
listFilesOnlyFlag: BOOL _ FALSE;

	LineWrite: STPSubr.RetrieveProcType = {
	line: STRING _ [1000];
	nlines: CARDINAL _ 0;

	skipRest _ FALSE;
	IF h.in.UserAbort[] THEN SIGNAL Subr.AbortMyself;
	IF ~ listFilesOnlyFlag THEN CWF.WF1["**** File %s:\n"L, fileName];
	WHILE Subr.GetLine[remoteStream, line] DO
        	IF ~ grepflag THEN CWF.WF1["%s\n"L, line]
        	ELSE IF Match[ grepPattern, line, ignoreCaseFlag ] THEN
            	IF listFilesOnlyFlag THEN {
            		CWF.WF1["%s "L, fileName]; 
            		EXIT;
            		}
            	ELSE 
            		CWF.WF2["%4d: %s\n"L, @nlines, line];
		IF h.in.UserAbort[] THEN SIGNAL Subr.AbortMyself;
		nlines _ nlines + 1;
		ENDLOOP;
	IF h.in.UserAbort[] THEN SIGNAL Subr.AbortMyself;
	IF ~grepflag THEN CWF.WFCR[];
	};

	
{
ENABLE 
	STP.Error => {
		CWF.WF0["FTP Error. "L];
		IF error ~= NIL THEN CWF.WF1["message: %s\n"L,error];
		GOTO leave;
		};
	
typedPattern: BOOL_FALSE;
grepflag _ FALSE;
parm _ 1;
WHILE parm < argv.argc DO
		flat _ RopeInline.InlineFlatten[argv[parm]];
		Subr.strcpy[token, LOOPHOLE[flat]];
		parm _ parm + 1;
		IF token[0] = '- OR token[0] = '/ THEN {
			FOR i: CARDINAL IN [1 .. token.length) DO
				SELECT String.UpperCase[ token[i] ] FROM
				'C => ignoreCaseFlag _ TRUE ;
				'L => listFilesOnlyFlag _ TRUE; 
               'G => {
					buffer: STRING _ [100] ;
					grepflag _ TRUE ;
					grepPattern.length _ 0;
					String.AppendChar[ grepPattern, '* ] ;
					flat _ RopeInline.InlineFlatten[argv[parm]];
					Subr.strcpy[buffer, LOOPHOLE[flat]];
					parm _ parm + 1;
					IF newpattern.length = 0 THEN { 
						String.AppendString[ grepPattern, buffer ]; 
						Subr.strcpy[newpattern, buffer];
						}
					ELSE String.AppendString[ grepPattern, newpattern ] ;
					String.AppendChar[ grepPattern, '* ] ;
					} ;
                ENDCASE =>
                    CWF.WF1[ "?Unknown switch: %s.*N"L, token] ;
                ENDLOOP ;
            LOOP ;
            } ;
	IF grepflag AND ~(listFilesOnlyFlag AND typedPattern) THEN {
		CWF.WF1[ "**** Pattern: %S, "L, grepPattern ]; 
		typedPattern_TRUE; 
		};
	IF h.in.UserAbort[] THEN SIGNAL Subr.AbortMyself;
	STPSubr.PatternGeneralOpen[filepattern: token, proc: LineWrite, h: h];
	ENDLOOP;
STPSubr.StopSTP[];
EXITS
leave => NULL;
}};


--## Match matches a string against a pattern with the standard matching 
--## characters: * and #.

Match: PROC[ pattern: STRING, str: STRING, ignoreCase: BOOL ] 
       RETURNS[ BOOL ] = BEGIN


RMatch: PROC[ p, s: CARDINAL ] 
        RETURNS[ b: BOOL ] = BEGIN


b _ FALSE ;    --## get rid of Mesa warning

WHILE TRUE DO
    IF p >= pattern.length THEN
        RETURN[ s >= str.length ] ;
    SELECT pattern[ p ] FROM
        '# => {
            IF s >= str.length THEN
                RETURN[ FALSE ] ;
            s _ s + 1 ;
            p _ p + 1 ;
            } ;
        '* => {
            IF p = pattern.length - 1 THEN
                RETURN[ TRUE ] ;
            WHILE TRUE DO
                IF RMatch[ p + 1, s ] THEN
                    RETURN[ TRUE ] ;
                IF (s _ s + 1) >= str.length THEN 
                    RETURN[ FALSE ] ;
                ENDLOOP ;
            } ;
        ENDCASE => {
            IF s >= str.length  THEN
                RETURN[ FALSE ] ;
            IF ignoreCase THEN  
                IF String.UpperCase[ pattern[ p ] ] # 
		String.UpperCase[ str[ s ] ] THEN
                    RETURN[ FALSE ] 
                ELSE NULL
            ELSE IF pattern[ p ] # str[ s ] THEN
                RETURN[ FALSE ] ;
            s _ s + 1 ;
            p _ p + 1 ;
            } ;             
    ENDLOOP ;

END ;  --## RMatch

--## main body of Match

RETURN[ RMatch[ 0, 0 ] ] ;

END ;

MyConfirm: PROC[in, out: IO.Handle, data: REF ANY, msg: Rope.ROPE, dch: CHAR]
	RETURNS[CHAR] = {
	value: ATOM;
	value _ UserExec.AskUser[msg:msg, exec: NARROW[data], 
		keyList: LIST[$Yes, $No]];  -- order is important
	SELECT value FROM
	$No => RETURN['n];
	$Yes => RETURN['y];
	ENDCASE => ERROR;
	};

MyPutChar: PROC[ch: CHAR] = {
	stdout.PutChar[ch];
	};
	

-- start code
UserExec.RegisterCommand["MType.~", Main];
}.