program quick_list;   { List source code headlines only }
Const
  Keyword : Array[1..3] of String[20] = ('PROCEDURE','FUNCTION','OVERLAY');
  Optword : Array[1..4] of String[20] = ('BEGIN','TYPE','CONST','VAR');

Type
  Line = string[128];
  Key  = string[128];

var
  TextLine : Line;
  FirstWord : Key;
  Count, Count1 : Integer;
  Source : Text;

Procedure UpCaseStr(Var S : Line);
Var
  I : Integer;
begin
  For I := 1 to Length(S) do
    S[I] := UpCase(S[I]);
end;

Function Keyword_Check(KW : Key) : Boolean;
var
  I : Integer;
begin
  Keyword_Check := False;
  UpCaseStr(KW);
  For I := 1 to 3 do
    if KW = Keyword[I] then
      KeyWord_Check := True;
end;

Function Optword_Check(KW : Key) : Boolean;
var
  I : Integer;
begin
  Optword_Check := False;
  UpCaseStr(KW);
  For I := 1 to 4 do
    if KW = Optword[I] then
      OptWord_Check := True;
end;

Procedure GetFirstWord(Text : Line; Var First : Key);
Var
  I,J : Integer;
  Ch : char;
begin
  I := 0;
  J := 0;
  Repeat
    I := Succ(I);
    Ch := Text[I];
  Until (Ch <> #32) OR (Ch = #13);
  if Ch = #13 then
    begin
      First[0] := #0;
      exit;
    end;
  J := I;
  Repeat
    J := Succ(J);
    Ch := Text[J];
  Until (Ch = #32) OR (Ch = #13);
  First := Copy(Text,I,(J - I));
end;

procedure QuickList;
begin
  While NOT EOF(Source) do
    begin
      ReadLn(Source,TextLine);
      GetFirstWord(TextLine,FirstWord);
      If Keyword_Check(FirstWord) then
        begin
          WriteLn(Lst,TextLine);
          repeat
            ReadLn(Source,TextLine);
            GetFirstWord(TextLine,FirstWord);
            If NOT OptWord_Check(FirstWord) then
              if Ord(TextLine[0]) > 0 then
                WriteLn(Lst,TextLine);
          until OptWord_Check(FirstWord);
        end;
    end;
    Write(Lst,#12,#13);
    Close(Source);
end;

procedure Initial;
begin
  Assign(Source,ParamStr(1));
  {$I-}
  Reset(Source);
  {$I+}
  If IOResult <> 0 then
    begin
      Write('Source code file name ? ');
      ReadLn(FirstWord);
      Assign(Source,Firstword);
      {$I-}
      Reset(Source);
      {$I+}
      if IOResult <> 0 then
        Begin
          Write('File not found, please check the name and try again.');
          Halt;
        end;
    end;
end;

begin
  Initial;
  QuickList;
end.