home *** CD-ROM | disk | FTP | other *** search
/ Media Share 13 / mediashare_13.zip / mediashare_13 / ZIPPED / PROGRAM / APR94_1.ZIP / ALLEY.ZIP / IDENT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-05  |  10KB  |  357 lines
  1. (* ------------------------------------------------------------*(
  2. **  ident.pas -- Convert key word identifiers in .PAS files.   **
  3. ** ------------------------------------------------------------**
  4. **                                                             **
  5. ** Converts key words in Pascal listings to lowercase, and     **
  6. ** marks them for bold facing. Words are marked using the      **
  7. ** symbols <* and *>. For example, <*begin*> is interpreted as **
  8. ** a bold faced "begin" key word. A word-processor macro could **
  9. ** search for all <* and *> symbols in the resulting file and  **
  10. ** replace these with bold face on and off commands.           **
  11. **                                                             **
  12. ** ------------------------------------------------------------**
  13. **  Copyright (c) 1994 by Tom Swan. All rights reserved.       **
  14. )* ------------------------------------------------------------*)
  15.  
  16. {$X+}  { Enable "extended" syntax }
  17.  
  18. program Ident;
  19.  
  20. uses Dos, Common, Search;
  21.  
  22. const
  23.  
  24.   bakExt  = '.BAK';   { Backup file extension }
  25.   tempExt = '.$$$';   { Temporary file extension }
  26.  
  27. type
  28.  
  29.   PString = ^String;
  30.  
  31.   PListRec = ^TListRec;
  32.   TListRec = record
  33.     Path: PString;
  34.     Next: PListRec
  35.   end;
  36.  
  37.   TState = (
  38.     Reading, Chkcomment, Comment1, Comment2, Stopcomment,
  39.     Stringing, Converting
  40.   );
  41.  
  42. var
  43.  
  44.   FileSpec: ComStr;         { Files entered on command line }
  45.   Root: PListRec;           { File name list root pointer }
  46.   DelimitWords: Boolean;    { True to add <* and *> to reserved words }
  47.   CapIdentifiers: Boolean;  { True to capitalize non-keywords }
  48.  
  49.  
  50. { Return copy of a string }
  51. function NewStr(S: String): PString;
  52. var
  53.   P: PString;
  54. begin
  55.   GetMem(P, Length(S) + 1);
  56.   if (P <> nil) then
  57.     PString(P)^ := S;
  58.   NewStr := P
  59. end;
  60.  
  61. { Return true if InF is successfully converted to OutF }
  62. function ConvertIdents(var InF, OutF: Text): Boolean;
  63. var
  64.   Ch, PushedCh: Char;
  65.   State: TState;
  66.   Identifier : IdentStr;
  67.  
  68.   function GetCh(var C: Char): Char;
  69.   begin
  70.     if PushedCh <> #0 then
  71.     begin
  72.       C := PushedCh;
  73.       PushedCh := #0
  74.     end else
  75.       Read(InF, C);
  76.     if (C = #13) or (C = #10) then
  77.     begin
  78.       if (C = #13) then
  79.         Writeln(OutF);  { Start new line }
  80.       C := #0           { Ignore new line characters }
  81.     end;
  82.     GetCh := C
  83.   end;
  84.  
  85.   procedure UngetCh(Ch: Char);
  86.   begin
  87.     PushedCh := Ch
  88.   end;
  89.  
  90.   procedure PutCh(Ch: Char);
  91.   begin
  92.     if Ch <> #0 then
  93.       Write(OutF, Ch)
  94.   end;
  95.  
  96. begin
  97.   PushedCh := #0;     { No pushed character }
  98.   State := Reading;
  99.   while not eof(InF) do
  100.   begin
  101.     GetCh(Ch);
  102.     case State of
  103.       Reading:
  104.       begin
  105.         case Ch of
  106.           '('  : State := Chkcomment;
  107.           '{'  : State := Comment1;
  108.           '''' : State := Stringing;
  109.         end;
  110.         if Ch in alphaSet then
  111.         begin
  112.           UngetCh(Ch);
  113.           State := Converting
  114.         end else
  115.           PutCh(Ch)
  116.       end;
  117.       Chkcomment:
  118.         if Ch = '*' then
  119.         begin
  120.           PutCh(Ch);
  121.           State := Comment2
  122.         end else begin
  123.           UngetCh(Ch);
  124.           State := Reading
  125.         end;
  126.       Comment1:
  127.       begin
  128.         PutCh(Ch);
  129.         if Ch = '}' then
  130.           State := Reading
  131.       end;
  132.       Comment2:
  133.       begin
  134.         PutCh(Ch);
  135.         if Ch = '*' then
  136.           State := Stopcomment
  137.       end;
  138.       Stopcomment:
  139.       begin
  140.         PutCh(Ch);
  141.         if Ch = ')' then
  142.           State := Reading
  143.         else
  144.           State := Comment2;
  145.       end;
  146.       Stringing:
  147.       begin
  148.         PutCh(Ch);
  149.         if Ch = '''' then
  150.           State := Reading;
  151.       end;
  152.       Converting:
  153.       begin
  154.         Identifier := '';
  155.         while Ch in identSet do
  156.         begin
  157.           Identifier := Identifier + Ch;
  158.           Read(InF, Ch)  { Note: Don't call GetCh here! }
  159.         end;
  160.         if IsReserved(Identifier) then
  161.         begin
  162.           DownCase(Identifier);
  163.           if DelimitWords then
  164.             Identifier := '<*' + Identifier + '*>'
  165.         end else
  166.         if CapIdentifiers and (Length(Identifier) > 0) then
  167.           Identifier[1] := UpCase(Identifier[1]);
  168.         Write(OutF, Identifier);
  169.         UngetCh(Ch);
  170.         State := Reading
  171.       end
  172.     end
  173.   end;
  174.   if PushedCh <> #0 then  { Write possible pushed last char that }
  175.     PutCh(Ch);            {  sets eof() to true. }
  176.   ConvertIdents := true
  177. end;
  178.  
  179. { Convert one file specified in Path string }
  180. procedure ConvertOneFile(Path: PathStr);
  181. var
  182.   Result: Integer;
  183.   BakF, InF, OutF: Text;
  184.   TempName, BakName: PathStr;
  185.   Name: NameStr;
  186.   Dir: DirStr;
  187.   Ext: ExtStr;
  188. begin
  189.   Write(Path);
  190.   Assign(InF, Path);
  191.   {$i-} Reset(InF); {$i+}
  192.   if IoResult <> 0 then
  193.     Writeln(' **Error opening file')
  194.   else begin
  195.     FSplit(Path, Dir, Name, Ext);
  196.     TempName := Dir + Name + tempExt;
  197.     BakName := Dir + Name + bakExt;
  198.     Assign(OutF, TempName);
  199.     {$i-} Rewrite(OutF); {$i+}
  200.     if IoResult <> 0 then
  201.       Writeln(' **Error creating output file')
  202.     else begin
  203.       if ConvertIdents(InF, OutF) then
  204.       begin
  205.         Close(InF);
  206.         Close(OutF);
  207.         Assign(BakF, BakName);
  208.         {$i-}
  209.         Erase(BakF);
  210.         Result := IoResult;      { Throw out IoResult }
  211.         Rename(InF, BakName);
  212.         Rename(OutF, Path);
  213.         {$i+}
  214.         if IoResult <> 0 then
  215.           Writeln(' **Error renaming files')
  216.         else
  217.           Writeln(' done')
  218.       end else
  219.         Writeln(' **Error processing files')
  220.     end
  221.   end
  222. end;
  223.  
  224. { Convert files on global list at Root pointer }
  225. procedure ConvertFiles(List: PListRec);
  226. begin
  227.   if List = nil then
  228.     Writeln('No files specified')
  229.   else
  230.     while List <> nil do
  231.     begin
  232.       ConvertOneFile(List^.Path^);
  233.       List := List^.Next
  234.     end
  235. end;
  236.  
  237. { Add file path to list }
  238. procedure ListFile(var List: PListRec; Path: PathStr);
  239. var
  240.   P: PListRec;
  241. begin
  242.   New(P);
  243.   P^.Next := List;
  244.   P^.Path := NewStr(Path);
  245.   if P^.Path = nil then
  246.     Dispose(P)
  247.   else
  248.     List := P
  249. end;
  250.  
  251. { Create list of file names from FileSpec string }
  252. procedure ListFiles(var List: PListRec);
  253. var
  254.   Sr: SearchRec;        { Directory search record }
  255.   L: Integer;           { Length of Dir string }
  256.   OldDir: DirStr;       { Old directory upon entry to procedure }
  257.   Path: PathStr;        { Expanded file specification with path info }
  258.   Dir: DirStr;          { Directory component of Path }
  259.   Name: NameStr;        { File name component of Path }
  260.   Ext: ExtStr;          { File extension component of Path }
  261. begin
  262.   GetDir(0, OldDir);             { Save current path }
  263.   Path := FExpand(FileSpec);     { Add path info to file spec }
  264.   FSplit(Path, Dir, Name, Ext);  { Separate Path components }
  265.   L := Length(Dir);              { Prepare to change directories }
  266.   if L > 0 then
  267.   begin
  268.     if (Dir[L] = '\') and (L > 1) and (Dir[L - 1] <> ':') then
  269.       Delete(Dir, L, 1); { Ensure that ChDir will work }
  270.     ChDir(Dir)           { Change to location of file(s) }
  271.   end;
  272.   FindFirst(Path, 0, Sr);        { Start file name search }
  273.   while DosError = 0 do          { Continue while files found }
  274.   begin
  275.     Path := FExpand(Sr.Name);    { Expand to full path name }
  276.     ListFile(List, Path);        { Add path to list }
  277.     FindNext(Sr)                 { Search for the next file }
  278.   end;
  279.   ChDir(OldDir)
  280. end;
  281.  
  282. { Display instructions }
  283. procedure Instruct;
  284. begin
  285.   Writeln('Use -b option to surround reserved words with');
  286.   Writeln('<* and *> for bold-facing in a word processor.');
  287.   Writeln('Use -c option to capitalize non-keyword identifers.');
  288.   Writeln;
  289.   Writeln('WARNING: After conversion with -b, the listing will');
  290.   Writeln('not compile. Use -b ONLY on a copy of original files.');
  291.   Writeln;
  292.   Writeln('ex. IDENT single.pas');
  293.   Writeln('    IDENT -b one.pas two.pas');
  294.   Writeln('    IDENT wild??.pas -b *.pas')
  295. end;
  296.  
  297. { Main program initializations }
  298. procedure Initialize;
  299. begin
  300.   Writeln;
  301.   Writeln('IDENT -- (C) 1994 by Tom Swan');
  302.   Writeln('Converts Pascal reserved words to lowercase.');
  303.   Writeln;
  304.   Root := nil;              { File name list is empty }
  305.   DelimitWords := false;    { Normally do not add <* and *> to words }
  306.   CapIdentifiers := false   { Normally do not capitalize other idents }
  307. end;
  308.  
  309. { Main program block }
  310.  
  311. var
  312.  
  313.   I: Integer;
  314.  
  315. begin
  316.   Initialize;
  317.   if ParamCount = 0 then
  318.     Instruct
  319.   else for I := 1 to ParamCount do
  320.   begin
  321.     FileSpec := ParamStr(I);
  322.     if (FileSpec = '-b') or (FileSpec = '-B') then
  323.       DelimitWords := true
  324.     else if (FileSpec = '-c') or (FileSpec = '-C') then
  325.       CapIdentifiers := true
  326.     else begin
  327.       ListFiles(Root);
  328.       ConvertFiles(Root)
  329.     end
  330.   end
  331. end.
  332.  
  333. (*
  334. // Copyright (c) 1991,1992 by Tom Swan. All rights reserved
  335. // Revision 2.00    Date: 6/21/1991
  336. // - Converted from INDENTIFIER in Pascal Programs for Business
  337. // - Added wild-card support
  338. // Revision 2.01    Date: 07/11/1991   Time: 08:51 am
  339. // - Added virtual to key word list
  340. // - Added CapIdentifiers switch
  341. // Revision 2.02    Date: 07/03/1992   Time: 02:33 pm
  342. // - Added exports (TPW), near, far key words
  343. // - Fixed bug that deleted '.' from 'end.' if the file does
  344. //   not end with cr/lf or eof, by writing a final pushed char.
  345. // Revision 2.03    Date: 11/12/1992   Time: 10:40 am
  346. // - Added public, private, and inherited key words
  347. // - Added export and library key words
  348. // Revision 2.04    Date: 01/04/1994   Time: 09:41 am
  349. // - Modified units for compilation with BP7
  350. // - Added PString type, formerly imported from objects.tpu
  351. // - Added NewStr function, formerly imported from objects.tpu
  352. // - Replaced binary search with trie search algorithm
  353. *)
  354.  
  355.  
  356.  
  357.