DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »SEARCH.PAS«

└─⟦61d7681d7⟧ Bits:30009789/_.ft.Ibm2.50006629.imd Mogens Pelles Zilog 80,000 / EOS projekt
    └─⟦this⟧ »SEARCH.PAS« 

TextFile

program search;
(* Searches a text file for all occurrences of a string.
   Whenever the string is found in the file, it is
   listed on the terminal together with the surrounding
   lines and their line numbers.
     All lines that contain the string are marked with a
   star.
     During the search, lower case and upper case letters
   are considered equal. This applies only to English
   letters. *)

(*R+*)
const linesBefore = 3;   (* number of lines listed before *)
      linesAfter = 3;    (* and after an interesting one  *)

type oneLine = string(.120.);

var filename : string(.20.);
    infile : text;

(************************************************)
(* Variables and procedures for line buffering: *)

const bufferMax = 3;     (* max(linesBefore, linesAfter) *)

var lines : array(.0..bufferMax.) of oneLine;
        (* contains buffered lines *)
    first, last : integer;
        (* line no. of first and last buffered line.
           'Last' always will be in the interval
           (first-1)..(first+bufferMax)     *)
    posFirst : 0..bufferMax;
        (* index of saved line no. 'first'. The others
           (numbered first+1..last) follow in
           successive indices                     *)

procedure initLineBuffering;
begin
  first := 1; last := 0; posFirst := 0;
  (* no lines buffered *)
end;

procedure getLine(lineNo : integer;
                  var line : oneLine;
                  var notFound : boolean);
(* If line no. 'lineNo' is within the file, 'lineNo'
   must be in the range first..(last+1) *)
var p : 0..bufferMax;
begin
  if (lineNo < 1) or (lineNo > last) and eof(infile) then
    notFound := true
  else
  if (lineNo < first) or (lineNo > last+1) then begin
    writeln(lst, 'Fejl i programmet. First = ', first,
                 '  last = ', last, '  lineNo = ', lineNo);
    notFound := true
  end else
  if lineNo <= last then begin
    p := (lineNo-first+posFirst) mod (bufferMax+1);
    line := lines(.p.); notFound := false;
  end else begin
    (* lineNo = last+1 *)
    if last-first+1 > bufferMax then begin (* = bufferMax+1 *)
      first := first+1; posFirst := (posFirst+1) mod (bufferMax+1)
    end;
    last := lineNo;
    p := (lineNo-first+posFirst) mod (bufferMax+1);
    readln(infile, lines(.p.));
    line := lines(.p.); notFound := false
  end;
  if (last-first+1) > bufferMax+1 then
    writeln(lst, 'Fejl i programmet. Last = ', last,
                 '  first = ', first);
end; (* getLine *)

(* end of variables and procedures for line buffering *)
(******************************************************)

var lineNo, lastLineWritten, firstLine, i : integer;
    line, target : oneLine;
    fileEnd, absent : boolean;

procedure uppercase(var s : oneLine);
var i : integer;
begin
  for i := 1 to length(s) do
    if (s(.i.) >= 'a') and (s(.i.) <= 'z') then
      s(.i.) := chr(ord(s(.i.))-32)
end;

begin
  write('Fil, der skal søges i: '); readln(filename);
  assign(infile, filename);
  (*$I-*) reset(infile); (*$I+*)
  if ioresult <> 0 then
    writeln('Filen ', filename, ' findes ikke')
  else begin
    write('Teksten, der skal søges efter: '); readln(target);
    uppercase(target);
    writeln(lst, 'Udskrift fra søgning i filen ', filename,
                 ' efter teksten "', target, '"');
    writeln(lst);
    initLineBuffering;
    fileEnd := false; lineNo := 1; lastLineWritten := 0;
    getLine(lineNo, line, fileEnd);
    while not fileEnd do begin
      uppercase(line);
      if pos(target, line) <> 0 then begin
        firstLine := lineNo-linesBefore;
        if firstLine > lastLineWritten+1 then
          writeln(lst)
        else
          firstLine := lastLineWritten+1;
         for i := firstLine to lineNo+linesAfter do begin
          getLine(i, line, absent);
          if not absent then begin
            uppercase(line);
            if pos(target, line) <> 0 then
              write(lst, '*')
            else
              write(lst, ' ');
(*
            if i < lineNo then write(lst, '<') else
            if i = lineNo then write(lst, '=') else write(lst, '>');
*)
            getLine(i, line, absent);
            writeln(lst, i:5, ' ', line);
            lastLineWritten := i;
          end;
        end;
      end;
      lineNo := lineNo + 1;
      getLine(lineNo, line, fileEnd);
    end;
    writeln(lst);
    writeln(lst, 'Der var ', lineNo-1,
                 ' linier i filen ', filename);
    write(lst, chr(12));
  end;
end.
«eof»