home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PASCAL / PT03.ZIP / FINDP.AR < prev    next >
Encoding:
Text File  |  1983-09-01  |  2.0 KB  |  86 lines
  1. -h- findcons.fnd 305
  2. { findcons -- const declarations for find }
  3. const
  4.  MAXPAT = MAXSTR;
  5.  CLOSIZE = 1; { size of a closure entry }
  6.  CLOSURE = STAR;
  7.  BOL = PERCENT;
  8.  EOL = DOLLAR;
  9.  ANY = QUESTION;
  10.  CCL = LBRACK;
  11.  CCLEND = RBRACK;
  12.  NEGATE = CARET;
  13.  NCCL = EXCLAM; { cannot be the same as NEGATE }
  14.  LITCHAR = LETC; { ord('c') }
  15.  
  16. -h- findp.fnd 957
  17. { find -- find patterns in text }
  18. procedure find;
  19. {$include:'findcons.fnd'}
  20. var
  21.  arg, lin, pat : string;
  22.  iarg : integer;
  23.  ifn  : lstring(MAXFN);  {input filename }
  24.  ii   : integer;
  25. {$include:'getpat.ted'  }
  26. {$include:'match.ted'   }
  27. begin
  28.  if (not getarg(1, arg, MAXSTR)) then
  29.   error('usage: find pattern [input-file ...]');
  30.  if (not getpat(arg, pat)) then
  31.   error('find: illegal pattern');
  32.  iarg := 1;
  33.  while (iarg = 1) or (iarg < nargs) do begin
  34.   iarg := iarg + 1;
  35.   if (getarg(iarg,arg,MAXSTR)) then begin
  36.    for ii := 1 to length(arg) do ifn[ii] := chr(arg[ii]);
  37.    ifn[0] := chr(length(arg));
  38.    close(input);
  39.    assign(input,ifn);
  40.    reset(input);
  41.   end;
  42.   if (nargs > 2) then begin
  43.    putc(LESS); putstr(arg, STDOUT); putc(GREATER); putc(NEWLINE);
  44.    end;
  45.   ii := 0;
  46.   while (getline(lin, STDIN, MAXSTR)) do begin
  47.    ii := ii + 1;
  48.    if (match(lin, pat)) then begin
  49.     putdec(ii,3); putc(COLON);
  50.     putstr(lin, STDOUT)
  51.    end;
  52.   end;
  53.  end;
  54. end;
  55. -h- findp.pas 509
  56. {$debug-}
  57. program outer (input,output);
  58.  
  59. {$include:'globcons.inc'}
  60. {$include:'globtyps.inc'}
  61.  
  62. {$include:'initio.dcl'  }
  63. {$include:'flush.dcl'   }
  64. {$include:'getline.dcl' }
  65. {$include:'putc.dcl'    }
  66. {$include:'putstr.dcl'  }
  67. {$include:'getarg.dcl'  }
  68. {$include:'nargs.dcl'   }
  69. {$include:'length.dcl'  }
  70. {$include:'error.dcl'   }
  71. {$include:'putdec.dcl'  }
  72. {$include:'addstr.dcl'  }
  73. {$include:'isalphan.dcl'}
  74. {$include:'esc.dcl'     }
  75.  
  76. {$include:'findp.fnd'   }
  77. BEGIN
  78.   minitio; initio;
  79.   find;
  80.   flush(0);
  81. END.
  82. -h- findp.mak 123
  83. findp+initio+getfcb+error+getarg+nargs+length+putc+
  84. getline+putdec+addstr+isalphan+esc+putcf+flush+
  85. itoc+getcf+getc+putstr
  86.