home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TP002.ZIP / QKLST.PQS / qklst.pas
Encoding:
Pascal/Delphi Source File  |  1986-08-27  |  2.4 KB  |  120 lines
  1. program quick_list;   { List source code headlines only }
  2. Const
  3.   Keyword : Array[1..3] of String[20] = ('PROCEDURE','FUNCTION','OVERLAY');
  4.   Optword : Array[1..4] of String[20] = ('BEGIN','TYPE','CONST','VAR');
  5.  
  6. Type
  7.   Line = string[128];
  8.   Key  = string[128];
  9.  
  10. var
  11.   TextLine : Line;
  12.   FirstWord : Key;
  13.   Count, Count1 : Integer;
  14.   Source : Text;
  15.  
  16. Procedure UpCaseStr(Var S : Line);
  17. Var
  18.   I : Integer;
  19. begin
  20.   For I := 1 to Length(S) do
  21.     S[I] := UpCase(S[I]);
  22. end;
  23.  
  24. Function Keyword_Check(KW : Key) : Boolean;
  25. var
  26.   I : Integer;
  27. begin
  28.   Keyword_Check := False;
  29.   UpCaseStr(KW);
  30.   For I := 1 to 3 do
  31.     if KW = Keyword[I] then
  32.       KeyWord_Check := True;
  33. end;
  34.  
  35. Function Optword_Check(KW : Key) : Boolean;
  36. var
  37.   I : Integer;
  38. begin
  39.   Optword_Check := False;
  40.   UpCaseStr(KW);
  41.   For I := 1 to 4 do
  42.     if KW = Optword[I] then
  43.       OptWord_Check := True;
  44. end;
  45.  
  46. Procedure GetFirstWord(Text : Line; Var First : Key);
  47. Var
  48.   I,J : Integer;
  49.   Ch : char;
  50. begin
  51.   I := 0;
  52.   J := 0;
  53.   Repeat
  54.     I := Succ(I);
  55.     Ch := Text[I];
  56.   Until (Ch <> #32) OR (Ch = #13);
  57.   if Ch = #13 then
  58.     begin
  59.       First[0] := #0;
  60.       exit;
  61.     end;
  62.   J := I;
  63.   Repeat
  64.     J := Succ(J);
  65.     Ch := Text[J];
  66.   Until (Ch = #32) OR (Ch = #13);
  67.   First := Copy(Text,I,(J - I));
  68. end;
  69.  
  70. procedure QuickList;
  71. begin
  72.   While NOT EOF(Source) do
  73.     begin
  74.       ReadLn(Source,TextLine);
  75.       GetFirstWord(TextLine,FirstWord);
  76.       If Keyword_Check(FirstWord) then
  77.         begin
  78.           WriteLn(Lst,TextLine);
  79.           repeat
  80.             ReadLn(Source,TextLine);
  81.             GetFirstWord(TextLine,FirstWord);
  82.             If NOT OptWord_Check(FirstWord) then
  83.               if Ord(TextLine[0]) > 0 then
  84.                 WriteLn(Lst,TextLine);
  85.           until OptWord_Check(FirstWord);
  86.         end;
  87.     end;
  88.     Write(Lst,#12,#13);
  89.     Close(Source);
  90. end;
  91.  
  92. procedure Initial;
  93. begin
  94.   Assign(Source,ParamStr(1));
  95.   {$I-}
  96.   Reset(Source);
  97.   {$I+}
  98.   If IOResult <> 0 then
  99.     begin
  100.       Write('Source code file name ? ');
  101.       ReadLn(FirstWord);
  102.       Assign(Source,Firstword);
  103.       {$I-}
  104.       Reset(Source);
  105.       {$I+}
  106.       if IOResult <> 0 then
  107.         Begin
  108.           Write('File not found, please check the name and try again.');
  109.           Halt;
  110.         end;
  111.     end;
  112. end;
  113.  
  114. begin
  115.   Initial;
  116.   QuickList;
  117. end.
  118.  
  119.  
  120.  check the name and try aga