home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ADC_TP3.ZIP / CLENUP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-04-15  |  15.9 KB  |  532 lines
  1. Program cleanup;
  2.  
  3. { This program "cleans up" the source code of your Turbo-Pascal
  4. applications before printing/uploading. It passes through your
  5. source code twice: once to convert all words (except comments
  6. and strings within WRITE(LN) statements) to lower case and once
  7. again to capitalize the reserved words of Pascal.
  8.  
  9. Usage requires a "scratch" area on the logged disk of at least
  10. the size of the source file. This will hold the workfile during
  11. the transition between passes of CLEANUP. Please read the note in
  12. the INITKEYS procedure of the casefix section. It will give
  13. you instructions on how to set the global constant "RESERVED"
  14. based on which TURBO version you are using. Also, PLEASE be
  15. patient. the search through the key word array takes time and
  16. may warrant a coffee break.
  17.  
  18. Thanks go to Bill Cote and J.W. Kindschi, Jr. for their programs
  19. LOWCASE.PAS and TURBFIX.PAS (respectively). These two programs
  20. were combined with some additional code to get to what you
  21. see in this program.
  22.  
  23. A final note: this program is valid for TURBO version 3.0, and
  24. has been tested on my CPM-80 system. I assume it will work on
  25. MSDOS, CPM86 and others. Please help out with revisions, etc.
  26. and keep me posted.
  27.  
  28. 7/31/85, Doug Pearson [75366,2413] }
  29.  
  30. Const
  31.      c1= 135;
  32.      c2= 15;
  33.      reserved=165; {see INITKEYS below for important info on this}
  34.  
  35. Type
  36.      name= String[14];
  37.      cmd=  (r,w);
  38.      alpha= String[c2];
  39.  
  40. Var
  41.      lptr,wptr,i,j: Integer;
  42.      id      : alpha;
  43.      f,g     : Text;
  44.      ch      : Char;
  45.      line    : String[c1];
  46.      found   : Boolean;
  47.      source,
  48.      dest    : name;
  49.      key     : Array[1..reserved] Of alpha;
  50.  
  51.  
  52. Function exists(filename: name; func: cmd): Boolean;
  53. Begin
  54.      If func = r Then Assign(f,filename) Else Assign(g,filename);
  55.      {$I-}
  56.      If func = r Then Reset(f) Else Rewrite(g);
  57.      {$I+}
  58.      If Ioresult <> 0 Then exists:=False  Else exists:=True;
  59. End;
  60.  
  61. Procedure lowcase;
  62.  
  63.  Procedure lowercase(Var Str:alpha);
  64.  Var i,x: Integer;
  65.  
  66.  Begin
  67.     For i := 1 To Length(Str) Do
  68.         If ((Ord(Str[i]) >= 65) And (Ord(Str[i]) <= 90)) Then
  69.         Begin
  70.             x := Ord(Str[i]);
  71.             Str[i] := Char(x + $20)
  72.         End;
  73.  End;
  74.  
  75.  
  76. Begin
  77.      Repeat
  78.         Clrscr;
  79.         Gotoxy(1,5);
  80.         Writeln('This program converts upper to lower case');
  81.         Writeln('and capitalizes reserved words');
  82.         Write('Input File: ');
  83.         Readln(source);
  84.      Until exists(source,r);
  85.      Gotoxy(1,15);
  86.      Clreol;
  87.      Write('Destination File: ');
  88.      Readln(dest);
  89.    If exists('tempfile',w) Then Begin
  90.      Readln(f,line);
  91.      While ((Not Eof(f)) Or (line<>'')) Do
  92.      Begin
  93.      If line <> '' Then Begin
  94.       lptr:=1;
  95.       While lptr<=Length(line) Do Begin
  96.         If line[lptr] = '{' Then Begin
  97.               Repeat
  98.                 lptr:= lptr + 1;
  99.                 If lptr>Length(line) Then Begin
  100.                   Writeln(g,line);
  101.                   Readln(f,line);
  102.                   lptr:=1;
  103.                 End;
  104.               Until line[lptr] = '}';
  105.               If Lptr<length(line) Then lptr:= lptr+1;
  106.         End;
  107.         If line[lptr] = '''' then begin
  108.               Repeat
  109.                 lptr:= lptr + 1;
  110.               Until line[lptr]= '''';
  111.               lptr:= lptr+1;
  112.         End;
  113.         If line[lptr] In ['A'..'Z'] Then Begin
  114.          wptr:=1; id:='';
  115.          Repeat
  116.             id := Concat(id,line[lptr+wptr-1]);
  117.             wptr:=wptr+1;
  118.          Until Not (line[lptr+wptr-1] In ['A'..'Z','a'..'z'])
  119.            Or (lptr+wptr-1 > Length(line));
  120.           lowercase(id);
  121.           Delete(line,lptr,Length(id));
  122.           Insert(id,line,lptr);
  123.           lptr:=lptr+wptr;
  124.         End
  125.         Else lptr:=lptr+1;
  126.       End; {while lptr}
  127.      End; {<>''}
  128.      Writeln(g,line);
  129.      Readln(f,line);
  130.     End; {eof test}
  131.    End; {if tempfile ok}
  132.    Close(f);
  133.    Close(g);
  134. End; {lowercase}
  135.  
  136.  
  137. Procedure casefix;
  138.  
  139. Procedure uppercase(Var Str:alpha);
  140. Var i: Integer;
  141. Begin
  142.      For i:=1 To Length(Str) Do Str[i]:=Upcase(Str[i]);
  143. End;
  144.  
  145. Procedure initkeys;
  146.  
  147. {The calling program should define one constant and one variable:
  148. RESERVED and KEY. RESERVED is an integer and should be set to a
  149. value from the following table:
  150.  
  151.           If your system is:           RESERVED should be:
  152.                CPM80                         165
  153.                CPM86                         169
  154.                MSDOS (standard)              177
  155.                MSDOS w/ graphics             211
  156.                MSDOS w/ extended graphics    244
  157.  
  158. KEY should be defined as follows: Var KEY: Array[1..RESERVED] of String[15];
  159. This Procedure can then be called with the statement "Initkeys;".}
  160.  
  161.  
  162. Type
  163.      computers= (cpm80,cpm86,msdos);
  164.  
  165. Var
  166.      op_system: computers;
  167.      has_graphics,has_extended_graphics,has_bcd: Boolean;
  168.  
  169. Begin
  170.                      op_system:= cpm80;
  171.                   has_graphics:= False;
  172.          has_extended_graphics:= False;
  173.                        has_bcd:= False;
  174.  
  175.          key[1] := 'ABS';
  176.          key[2] := 'ABSOLUTE';
  177.          key[3] := 'ADDR';
  178.          key[4] := 'AND';
  179.          key[5] := 'APPEND';
  180.          key[6] := 'ARCTAN';
  181.          key[7] := 'ARRAY';
  182.          key[8] := 'ASSIGN';
  183.          key[9] := 'AUX';
  184.          key[10] := 'AUXINPTR';
  185.          key[11] := 'AUXOUTPTR';
  186.          key[12] := 'BEGIN';
  187.          key[13] := 'BLOCKREAD';
  188.          key[14] := 'BLOCKWRITE';
  189.          key[15] := 'BOOLEAN';
  190.          key[16] := 'BUFLEN';
  191.          key[17] := 'BYTE';
  192.          key[18] := 'CASE';
  193.          key[19] := 'CHAIN';
  194.          key[20] := 'CHAR';
  195.          key[21] := 'CHR';
  196.          key[22] := 'CLOSE';
  197.          key[23] := 'CLREOL';
  198.          key[24] := 'CLRSCR';
  199.          key[25] := 'CON';
  200.          key[26] := 'CONCAT';
  201.          key[27] := 'CONINPTR';
  202.          key[28] := 'CONOUTPTR';
  203.          key[29] := 'CONST';
  204.          key[30] := 'CONSTPTR';
  205.          key[31] := 'COPY';
  206.          key[32] := 'COS';
  207.          key[33] := 'CRTEXIT';
  208.          key[34] := 'CRTINIT';
  209.          key[35] := 'DELAY';
  210.          key[36] := 'DELETE';
  211.          key[37] := 'DELLINE';
  212.          key[38] := 'DISPOSE';
  213.          key[39] := 'DIV';
  214.          key[40] := 'DO';
  215.          key[41] := 'DOWNTO';
  216.          key[42] := 'ELSE';
  217.          key[43] := 'END';
  218.          key[44] := 'EOF';
  219.          key[45] := 'EOLN';
  220.          key[46] := 'ERASE';
  221.          key[47] := 'EXECUTE';
  222.          key[48] := 'EXIT';
  223.          key[49] := 'EXP';
  224.          key[50] := 'EXTERNAL';
  225.          key[51] := 'FALSE';
  226.          key[52] := 'FILE';
  227.          key[53] := 'FILEPOS';
  228.          key[54] := 'FILESIZE';
  229.          key[55] := 'FILLCHAR';
  230.          key[56] := 'FLUSH';
  231.          key[57] := 'FOR';
  232.          key[58] := 'FORWARD';
  233.          key[59] := 'FRAC';
  234.          key[60] := 'FREEMEM';
  235.          key[61] := 'FUNCTION';
  236.          key[62] := 'GETMEM';
  237.          key[63] := 'GOTO';
  238.          key[64] := 'GOTOXY';
  239.          key[65] := 'HALT';
  240.          key[66] := 'HEAPPTR';
  241.          key[67] := 'HI';
  242.          key[68] := 'IF';
  243.          key[69] := 'IN';
  244.          key[70] := 'INLINE';
  245.          key[71] := 'INPUT';
  246.          key[72] := 'INSERT';
  247.          key[73] := 'INSLINE';
  248.          key[74] := 'INT';
  249.          key[75] := 'INTEGER';
  250.          key[76] := 'IORESULT';
  251.          key[77] := 'KBD';
  252.          key[78] := 'KEYPRESSED';
  253.          key[79] := 'LABEL';
  254.          key[80] := 'LENGTH';
  255.          key[81] := 'LN';
  256.          key[82] := 'LO';
  257.          key[83] := 'LOWVIDEO';
  258.          key[84] := 'LST';
  259.          key[85] := 'LSTOUTPTR';
  260.          key[86] := 'MARK';
  261.          key[87] := 'MAXAVAIL';
  262.          key[88] := 'MAXINT';
  263.          key[89] := 'MEM';
  264.          key[90] := 'MEMAVAIL';
  265.          key[91] := 'MEMW';
  266.          key[92] := 'MOD';
  267.          key[93] := 'MOVE';
  268.          key[94] := 'NEW';
  269.          key[95] := 'NIL';
  270.          key[96] := 'NORMVIDEO';
  271.          key[97] := 'NOT';
  272.          key[98] := 'ODD';
  273.          key[99] := 'OF';
  274.          key[100] := 'OR';
  275.          key[101] := 'ORD';
  276.          key[102] := 'OUTPUT';
  277.          key[103] := 'OVERLAY';
  278.          key[104] := 'PACKED';
  279.          key[105] := 'PARAMCOUNT';
  280.          key[106] := 'PARAMSTR';
  281.          key[107] := 'PI';
  282.          key[108] := 'PORT';
  283.          key[109] := 'POS';
  284.          key[110] := 'PRED';
  285.          key[111] := 'PROCEDURE';
  286.          key[112] := 'PROGRAM';
  287.          key[113] := 'PTR';
  288.          key[114] := 'RANDOM';
  289.          key[115] := 'RANDOMIZE';
  290.          key[116] := 'READ';
  291.          key[117] := 'READLN';
  292.          key[118] := 'REAL';
  293.          key[119] := 'RECORD';
  294.          key[120] := 'RELEASE';
  295.          key[121] := 'RENAME';
  296.          key[122] := 'REPEAT';
  297.          key[123] := 'RESET';
  298.          key[124] := 'REWRITE';
  299.          key[125] := 'ROUND';
  300.          key[126] := 'SEEK';
  301.          key[127] := 'SEEKEOF';
  302.          key[128] := 'SEEKEOLN';
  303.          key[129] := 'SET';
  304.          key[130] := 'SHL';
  305.          key[131] := 'SHR';
  306.          key[132] := 'SIN';
  307.          key[133] := 'SIZEOF';
  308.          key[134] := 'SQR';
  309.          key[135] := 'SQRT';
  310.          key[136] := 'STR';
  311.          key[137] := 'STRING';
  312.          key[138] := 'SUCC';
  313.          key[139] := 'SWAP';
  314.          key[140] := 'TEXT';
  315.          key[141] := 'THEN';
  316.          key[142] := 'TO';
  317.          key[143] := 'TRM';
  318.          key[144] := 'TRUE';
  319.          key[145] := 'TRUNC';
  320.          key[146] := 'TYPE';
  321.          key[147] := 'UNTIL';
  322.          key[148] := 'UPCASE';
  323.          key[149] := 'USR';
  324.          key[150] := 'USRINPTR';
  325.          key[151] := 'USROUTPTR';
  326.          key[152] := 'VAL';
  327.          key[153] := 'VAR';
  328.          key[154] := 'WHILE';
  329.          key[155] := 'WITH';
  330.          key[156] := 'WRITE';
  331.          key[157] := 'WRITELN';
  332.          key[158] := 'XOR';
  333.  
  334.  
  335.   Case op_system Of
  336.  
  337.     cpm80: Begin
  338.             key[159] := 'BDOS';
  339.             key[160] := 'BDOSHL';
  340.             key[161] := 'BIOS';
  341.             key[162] := 'BIOSHL';
  342.             key[163] := 'OVRDRIVE';
  343.             key[164] := 'RECURPTR';
  344.             key[165] := 'STACKPTR';
  345.            End;
  346.  
  347.     cpm86: Begin
  348.             key[159] := 'BDOS';
  349.             key[160] := 'BIOS';
  350.             key[161] := 'CSEG';
  351.             key[162] := 'DSEG';
  352.             key[163] := 'INTR';
  353.             key[164] := 'MEMW';
  354.             key[165] := 'OFS';
  355.             key[166] := 'OVRDRIVE';
  356.             key[167] := 'PORTW';
  357.             key[168] := 'SEG';
  358.             key[169] := 'SSEG';
  359.            End;
  360.  
  361.     msdos: Begin
  362.             key[159] := 'CHDIR';
  363.             key[160] := 'CSEG';
  364.             key[161] := 'DSEG';
  365.             key[162] := 'GETDIR';
  366.             key[163] := 'INTR';
  367.             key[164] := 'LONGFILEPOS';
  368.             key[165] := 'LONGFILESIZE';
  369.             key[166] := 'LONGSEEK';
  370.             key[167] := 'MEMW';
  371.             key[168] := 'MKDIR';
  372.             key[169] := 'MSDOS';
  373.             key[170] := 'OFS';
  374.             key[171] := 'OVRPATH';
  375.             key[172] := 'PORTW';
  376.             key[173] := 'RMDIR';
  377.             key[174] := 'SEG';
  378.             key[175] := 'SSEG';
  379.             key[176] := 'TRUNCATE';
  380.             key[177] := ''; {reserved for use in TURBO-BCD system}
  381.            End;
  382.   End; {Case of Op_System}
  383.  
  384.  
  385.   If ((op_system=msdos) And (has_graphics)) Then Begin
  386.  
  387.             key[177] := 'BLACK';
  388.             key[178] := 'BLINK';
  389.             key[179] := 'BLUE';
  390.             key[180] := 'BROWN';
  391.             key[181] := 'CYAN';
  392.             key[182] := 'DARKGRAY';
  393.             key[183] := 'DRAW';
  394.             key[184] := 'GRAPHBACKGROUND';
  395.             key[185] := 'GRAPHCOLORMODE';
  396.             key[186] := 'GRAPHMODE';
  397.             key[187] := 'GRAPHWINDOW';
  398.             key[188] := 'GREEN';
  399.             key[189] := 'HIRES';
  400.             key[190] := 'HIRESCOLOR';
  401.             key[191] := 'LIGHTBLUE';
  402.             key[192] := 'LIGHTCYAN';
  403.             key[193] := 'LIGHTGRAY';
  404.             key[194] := 'LIGHTGREEN';
  405.             key[195] := 'LIGHTMAGENTA';
  406.             key[196] := 'LIGHTRED';
  407.             key[197] := 'MAGENTA';
  408.             key[198] := 'NOSOUND';
  409.             key[199] := 'PALETTE';
  410.             key[200] := 'PLOT';
  411.             key[201] := 'RED';
  412.             key[202] := 'SOUND';
  413.             key[203] := 'TEXTBACKGROUND';
  414.             key[204] := 'TEXTCOLOR';
  415.             key[205] := 'TEXTMODE';
  416.             key[206] := 'WHEREX';
  417.             key[207] := 'WHEREY';
  418.             key[208] := 'WHITE';
  419.             key[209] := 'WINDOW';
  420.             key[210] := 'YELLOW';
  421.             key[211] := ''; {reserved for use in TURBO-BCD system}
  422.  
  423.             If has_extended_graphics Then Begin
  424.  
  425.                    key[211] := 'ARC';
  426.                    key[212] := 'BACK';
  427.                    key[213] := 'CIRCLE';
  428.                    key[214] := 'CLEARSCREEN';
  429.                    key[215] := 'COLORTABLE';
  430.                    key[216] := 'EAST';
  431.                    key[217] := 'FILLPATTERN';
  432.                    key[218] := 'FILLSCREEN';
  433.                    key[219] := 'FILLSHAPE';
  434.                    key[220] := 'GETDOTCOLOR';
  435.                    key[221] := 'GETPIC';
  436.                    key[222] := 'HEADING';
  437.                    key[223] := 'HIDETURTLE';
  438.                    key[224] := 'HOME';
  439.                    key[225] := 'NORTH';
  440.                    key[226] := 'NOWRAP';
  441.                    key[227] := 'PATTERN';
  442.                    key[228] := 'PENDOWN';
  443.                    key[229] := 'PENUP';
  444.                    key[230] := 'PUTPIC';
  445.                    key[231] := 'SETHEADING';
  446.                    key[232] := 'SETPENCOLOR';
  447.                    key[233] := 'SETPOSITION';
  448.                    key[234] := 'SHOWTURTLE';
  449.                    key[235] := 'SOUTH';
  450.                    key[236] := 'TURNLEFT';
  451.                    key[237] := 'TURNRIGHT';
  452.                    key[238] := 'TURTLETHERE';
  453.                    key[239] := 'TURTLEWINDOW';
  454.                    key[240] := 'WEST';
  455.                    key[241] := 'WRAP';
  456.                    key[242] := 'XCOR';
  457.                    key[243] := 'YCOR';
  458.                    key[244] := ''; {reserved for use in TURBO-BCD system}
  459.             End; {extended graphics}
  460.   End; {regular graphics}
  461.  
  462.   If ((op_system=msdos) And (has_bcd)) Then key[reserved] := 'FORM';
  463.  
  464.  
  465. End; {initkeys}
  466.  
  467.  
  468. Begin {casefix}
  469.      initkeys;
  470.      Clrscr;
  471.      Gotoxy(1,5);
  472.      Writeln('Now capitalizing');
  473.      Gotoxy(1,23);
  474.      Writeln('Press any key for a while to quit');
  475.      Readln(f,line);
  476.      While (Not (Eof(f) Or Keypressed)) Or (line<>'') Do
  477.      Begin
  478.      If line <> '' Then Begin
  479.       lptr:=1;
  480.       While lptr<=Length(line) Do Begin
  481.         If line[lptr] = '{' Then Begin
  482.               Repeat
  483.                 lptr:= lptr + 1;
  484.                 If lptr>Length(line) Then Begin
  485.                   Writeln(g,line);
  486.                   Readln(f,line);
  487.                   lptr:=1;
  488.                 End;
  489.               Until line[lptr] = '}';
  490.               lptr:= lptr+1;
  491.         End;
  492.         If line[lptr] = '''' then begin
  493.               Repeat
  494.                 lptr:= lptr + 1;
  495.               Until line[lptr]= '''';
  496.               lptr:= lptr+1;
  497.         End;
  498.         If line[lptr] In ['A'..'Z','a'..'z'] Then Begin
  499.          wptr:=1; id:='';
  500.          Repeat
  501.             id := Concat(id,line[lptr+wptr-1]);
  502.             wptr:=wptr+1;
  503.          Until Not (line[lptr+wptr-1] In ['A'..'Z','a'..'z'])
  504.            Or (lptr+wptr-1 > Length(line));
  505.           uppercase(id);
  506.           i:=1; found:=False;
  507.           While (i <= reserved) And (Not found) Do Begin
  508.             If id = key[i] Then Begin
  509.               found:=True;
  510.               line[lptr]:=Upcase(line[lptr]);
  511.             End;
  512.             i:=i+1;
  513.           End;
  514.           lptr:=lptr+wptr;
  515.         End
  516.         Else lptr:=lptr+1;
  517.       End; {while lptr}
  518.      End; {<>''}
  519.      Writeln(g,line);
  520.      Readln(f,line);
  521.     End; {eof test}
  522.     Close(f);
  523.     Close(g);
  524. End; {casefix}
  525.  
  526.  
  527. Begin {cleanup}
  528.    lowcase;
  529.    If exists('tempfile',r) And exists(dest,w) Then casefix;
  530.    Assign(f,'tempfile'); Erase(f);
  531. End.
  532.