home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PASUTIL1.ZIP / PARTC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  10.3 KB  |  315 lines
  1. FUNCTION STACKEMPTY (* RETURNING *) : BOOLEAN;
  2. BEGIN (* STACKEMPTY *)
  3.    IF TOP = 0
  4.       THEN
  5.          STACKEMPTY := TRUE
  6.       ELSE
  7.          STACKEMPTY := FALSE
  8. END; (* STACKEMPTY *)
  9. FUNCTION STACKFULL (* RETURNING *) : BOOLEAN;
  10. BEGIN (* STACKFULL *)
  11.    IF TOP = MAXSTACKSIZE
  12.       THEN
  13.          STACKFULL := TRUE
  14.       ELSE
  15.          STACKFULL := FALSE
  16. END; (* STACKFULL *)
  17. PROCEDURE POPSTACK( (* RETURNING *) VAR INDENTSYMBOL : KEYSYMBOL;
  18.                                     VAR PREVMARGIN   : INTEGER   );
  19. BEGIN (* POPSTACK *)
  20.    IF NOT STACKEMPTY
  21.       THEN
  22.          BEGIN
  23.             INDENTSYMBOL := STACK[TOP].INDENTSYMBOL;
  24.             PREVMARGIN   := STACK[TOP].PREVMARGIN;
  25.             TOP := TOP - 1
  26.          END
  27.       ELSE
  28.          BEGIN
  29.             INDENTSYMBOL := OTHERSYM;
  30.             PREVMARGIN   := 0
  31.          END
  32. END; (* POPSTACK *)
  33. PROCEDURE PUSHSTACK( (* USING *) INDENTSYMBOL : KEYSYMBOL;
  34.                                  PREVMARGIN   : INTEGER   );
  35. BEGIN (* PUSHSTACK *)
  36.    TOP := TOP + 1;
  37.    STACK[TOP].INDENTSYMBOL := INDENTSYMBOL;
  38.    STACK[TOP].PREVMARGIN   := PREVMARGIN
  39. END; (* PUSHSTACK *)
  40. PROCEDURE WRITECRS( (* USING *)          NUMBEROFCRS : INTEGER;
  41.                     (* UPDATING *)   VAR CURRLINEPOS : INTEGER );
  42. VAR
  43.     I: INTEGER;
  44. BEGIN (* WRITECRS *)
  45.    IF NUMBEROFCRS > 0
  46.       THEN
  47.          BEGIN
  48.             FOR I := 1 TO NUMBEROFCRS DO BEGIN
  49.  WRITELN;
  50.                WRITELN(FOUT) END;
  51.             CURRLINEPOS := 0
  52.          END
  53. END; (* WRITECRS *)
  54. PROCEDURE INSERTCR( (* UPDATING *)   VAR CURRSYM    : SYMBOLINFO );
  55. CONST
  56.       ONCE = 1;
  57. BEGIN (* INSERTCR *)
  58.    IF CURRSYM^.CRSBEFORE = 0
  59.       THEN
  60.          BEGIN
  61.             WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS );
  62.             CURRSYM^.SPACESBEFORE := 0
  63.          END
  64. END; (* INSERTCR *)
  65. PROCEDURE INSERTBLANKLINE( (* UPDATING *)   VAR CURRSYM : SYMBOLINFO );
  66. CONST
  67.       ONCE  = 1;
  68.       TWICE = 2;
  69. BEGIN (* INSERTBLANKLINE *)
  70.    IF CURRSYM^.CRSBEFORE = 0
  71.       THEN
  72.          BEGIN
  73.             IF CURRLINEPOS = 0
  74.                THEN
  75.                    WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS )
  76.                ELSE
  77.                   WRITECRS( TWICE, (* UPDATING *)   CURRLINEPOS );
  78.             CURRSYM^.SPACESBEFORE := 0
  79.          END
  80.       ELSE
  81.          IF CURRSYM^.CRSBEFORE = 1
  82.             THEN
  83.                IF CURRLINEPOS > 0
  84.                   THEN
  85.                      WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS )
  86. END; (* INSERTBLANKLINE *)
  87. PROCEDURE LSHIFTON( (* USING *) DINDENTSYMBOLS : KEYSYMSET );
  88. VAR
  89.     INDENTSYMBOL : KEYSYMBOL;
  90.     PREVMARGIN   : INTEGER;
  91. BEGIN (* LSHIFTON *)
  92.    IF NOT STACKEMPTY
  93.       THEN
  94.          BEGIN
  95.             REPEAT
  96.                POPSTACK( (* RETURNING *) INDENTSYMBOL,
  97.                                          PREVMARGIN   );
  98.                IF INDENTSYMBOL IN DINDENTSYMBOLS
  99.                   THEN
  100.                      CURRMARGIN := PREVMARGIN
  101.             UNTIL NOT(INDENTSYMBOL IN DINDENTSYMBOLS)
  102.                    OR (STACKEMPTY);
  103.             IF NOT(INDENTSYMBOL IN DINDENTSYMBOLS)
  104.                THEN
  105.                      PUSHSTACK( (* USING *) INDENTSYMBOL,
  106.                                          PREVMARGIN   )
  107.          END
  108. END; (* LSHIFTON *)
  109. PROCEDURE LSHIFT;
  110. VAR
  111.     INDENTSYMBOL: KEYSYMBOL;
  112.     PREVMARGIN  : INTEGER;
  113. BEGIN (* LSHIFT *)
  114.    IF NOT STACKEMPTY
  115.       THEN
  116.          BEGIN
  117.             POPSTACK( (* RETURNING *) INDENTSYMBOL,
  118.                                       PREVMARGIN   );
  119.             CURRMARGIN := PREVMARGIN
  120.          END
  121. END; (* LSHIFT *)
  122. PROCEDURE INSERTSPACE( (* USING *)      VAR SYMBOL     : SYMBOLINFO );
  123. BEGIN (* INSERTSPACE *)
  124.    IF CURRLINEPOS < MAXLINESIZE
  125.       THEN
  126.          BEGIN
  127.             WRITE(FOUT, SPACE); WRITE ( SPACE );
  128.             CURRLINEPOS := CURRLINEPOS + 1;
  129.             WITH SYMBOL^ DO
  130.                IF (CRSBEFORE = 0) AND (SPACESBEFORE > 0)
  131.                   THEN
  132.                      SPACESBEFORE := SPACESBEFORE - 1
  133.          END
  134. END; (* INSERTSPACE *)
  135. PROCEDURE MOVELINEPOS( (* TO *)       NEWLINEPOS  : INTEGER;
  136.                        (* FROM *) VAR CURRLINEPOS : INTEGER );
  137. VAR
  138.    I: INTEGER;
  139. BEGIN (* MOVELINEPOS *)
  140.    FOR I := CURRLINEPOS+1 TO NEWLINEPOS DO BEGIN WRITE ( SPACE );
  141.       WRITE(FOUT, SPACE) END;
  142.    CURRLINEPOS := NEWLINEPOS
  143. END; (* MOVELINEPOS *)
  144. PROCEDURE PRINTSYMBOL( (* IN *)             CURRSYM     : SYMBOLINFO;
  145.                        (* UPDATING *)   VAR CURRLINEPOS : INTEGER     );
  146. VAR
  147.    I : INTEGER;
  148. BEGIN (* PRINTSYMBOL *)
  149.    WITH CURRSYM^ DO
  150.       BEGIN
  151.          FOR I := 1 TO LENGTH DO BEGIN WRITE ( VALYOO[I] );
  152.             WRITE(FOUT, VALYOO[I]) END;
  153.          STARTPOS := CURRLINEPOS (* SAVE START POSITION FOR TABBING *);
  154.          CURRLINEPOS := CURRLINEPOS + LENGTH
  155.       END (* WITH *)
  156. END; (* PRINTSYMBOL *)
  157. PROCEDURE PPSYMBOL( (* IN *) CURRSYM : SYMBOLINFO );
  158. CONST
  159.       ONCE  = 1;
  160. VAR
  161.     NEWLINEPOS: INTEGER;
  162. BEGIN (* PPSYMBOL *)
  163.    WITH CURRSYM^ DO
  164.       BEGIN
  165.          WRITECRS( (* USING *)      CRSBEFORE,
  166.                    (* UPDATING *)   CURRLINEPOS );
  167.          IF (CURRLINEPOS + SPACESBEFORE > CURRMARGIN)
  168.             OR (NAME IN [ OPENCOMMENT, CLOSECOMMENT ])
  169.             THEN
  170.                NEWLINEPOS := CURRLINEPOS + SPACESBEFORE
  171.             ELSE
  172.                NEWLINEPOS := CURRMARGIN;
  173.          IF NEWLINEPOS + LENGTH > MAXLINESIZE
  174.             THEN
  175.                BEGIN
  176.                   WRITECRS( ONCE, (* UPDATING *)   CURRLINEPOS );
  177.                   IF CURRMARGIN + LENGTH <= MAXLINESIZE
  178.                      THEN
  179.                         NEWLINEPOS := CURRMARGIN
  180.                      ELSE
  181.                         IF LENGTH < MAXLINESIZE
  182.                            THEN
  183.                               NEWLINEPOS := MAXLINESIZE - LENGTH
  184.                            ELSE
  185.                               NEWLINEPOS := 0
  186.                END;
  187.          MOVELINEPOS( (* TO *)    NEWLINEPOS,
  188.                       (* FROM *)  CURRLINEPOS );
  189.          PRINTSYMBOL( (* IN *)         CURRSYM,
  190.                       (* UPDATING *)   CURRLINEPOS )
  191.       END (* WITH *)
  192. END; (* PPSYMBOL *)
  193. PROCEDURE RSHIFTTOCLP( (* USING *) CURRSYM : KEYSYMBOL );
  194.    FORWARD;
  195. PROCEDURE GOBBLE(
  196.                   (* UP TO *)            TERMINATORS : KEYSYMSET;
  197.                   (* UPDATING *)     VAR CURRSYM,
  198.                                          NEXTSYM     : SYMBOLINFO );
  199. BEGIN (* GOBBLE *)
  200.    RSHIFTTOCLP( (* USING *) CURRSYM^.NAME );
  201.    WHILE NOT(NEXTSYM^.NAME IN (TERMINATORS + [ENDOFFILE])) DO
  202.       BEGIN
  203.          GETSYMBOL(
  204.                     (* UPDATING *)  NEXTSYM,
  205.                     (* RETURNING *) CURRSYM   );
  206.          PPSYMBOL( (* IN *)         CURRSYM )
  207.       END; (* WHILE *)
  208.    LSHIFT
  209. END; (* GOBBLE *)
  210. PROCEDURE RSHIFT( (* USING *) CURRSYM : KEYSYMBOL );
  211. BEGIN (* RSHIFT *)
  212.    IF NOT STACKFULL
  213.       THEN
  214.          PUSHSTACK( (* USING *) CURRSYM,
  215.                                 CURRMARGIN);
  216.    IF STARTPOS > CURRMARGIN
  217.       THEN
  218.          CURRMARGIN := STARTPOS;
  219.    IF CURRMARGIN < SLOFAIL1
  220.       THEN
  221.          CURRMARGIN := CURRMARGIN + INDENT1
  222.       ELSE
  223.                                     IF CURRMARGIN < SLOFAIL2
  224.             THEN
  225.                CURRMARGIN := CURRMARGIN + INDENT2
  226. END; (* RSHIFT *)
  227. PROCEDURE RSHIFTTOCLP;
  228. BEGIN (* RSHIFTTOCLP *)
  229.    IF NOT STACKFULL
  230.       THEN
  231.          PUSHSTACK( (* USING *) CURRSYM,
  232.                                 CURRMARGIN);
  233.    CURRMARGIN := CURRLINEPOS
  234. END; (* RSHIFTTOCLP *)
  235. BEGIN (* PRETTYPRINT *)
  236.  WRITE ( ' ENTER TEXT FILE TO BE PRETTYPRINTED - - > ');
  237.  READLN ( PROGIN );
  238.    (*     CONCAT(PROGIN,'.PAS');          *)
  239.  WRITELN;
  240.  WRITE ( 'ENTER NEW FILE NAME OF PRETTYPRINTED PROGRAM - - > ');
  241.  READLN ( PROGOUT );
  242.    (*     CONCAT(PROGOUT,'.PAS');          *)
  243.  WRITELN;
  244.  WRITELN (' NOW PRETTYPRINTING.....');
  245.  
  246.  ASSIGN( FIN,PROGIN);
  247.  ASSIGN(FOUT,PROGOUT);
  248.  REWRITE ( FOUT ) ;
  249.  RESET ( FIN ) ;
  250.  
  251.    INITIALIZE( TOP,        CURRLINEPOS,
  252.                CURRMARGIN, KEYWORD,    DBLCHARS,    DBLCHAR,
  253.                SGLCHAR,    RECORDSEEN, CURRCHAR,    NEXTCHAR,
  254.                CURRSYM,    NEXTSYM,    PPOPTION );
  255.    CRPENDING := FALSE;
  256.    WHILE (NEXTSYM^.NAME <> ENDOFFILE) DO
  257.      BEGIN
  258.          GETSYMBOL(
  259.                     (* UPDATING *)  NEXTSYM,
  260.                     (* RETURNING *) CURRSYM   );
  261.          WITH PPOPTION [CURRSYM^.NAME] DO
  262.             BEGIN
  263.                IF (CRPENDING AND NOT(CRSUPPRESS IN OPTIONSSELECTED))
  264.                  OR (CRBEFORE IN OPTIONSSELECTED)
  265.                   THEN
  266.                      BEGIN
  267.                         INSERTCR( (* USING *) CURRSYM);
  268.                         CRPENDING := FALSE
  269.                      END;
  270.                IF BLANKLINEBEFORE IN OPTIONSSELECTED
  271.                   THEN
  272.                      BEGIN
  273.                         INSERTBLANKLINE( (* USING *) CURRSYM);
  274.                         CRPENDING := FALSE
  275.                      END;
  276.                IF DINDENTONKEYS IN OPTIONSSELECTED
  277.                   THEN
  278.                      LSHIFTON(DINDENTSYMBOLS);
  279.                IF DINDENT IN OPTIONSSELECTED
  280.                   THEN
  281.                      LSHIFT;
  282.                IF SPACEBEFORE IN OPTIONSSELECTED
  283.                   THEN
  284.                      INSERTSPACE( (* USING *) CURRSYM );
  285.                PPSYMBOL( (* IN *) CURRSYM );
  286.                IF SPACEAFTER IN OPTIONSSELECTED
  287.                   THEN
  288.                      INSERTSPACE( (* USING *) NEXTSYM );
  289.                IF INDENTBYTAB IN OPTIONSSELECTED
  290.                   THEN
  291.                      RSHIFT( (* USING *) CURRSYM^.NAME );
  292.                IF INDENTTOCLP IN OPTIONSSELECTED
  293.                   THEN
  294.                      RSHIFTTOCLP( (* USING *) CURRSYM^.NAME );
  295.                IF GOBBLESYMBOLS IN OPTIONSSELECTED
  296.                   THEN
  297.                      GOBBLE(
  298.                              (* UP TO *)        GOBBLETERMINATORS,
  299.                              (* UPDATING *)     CURRSYM,
  300.                                                 NEXTSYM            );
  301.                IF CRAFTER IN OPTIONSSELECTED
  302.                   THEN
  303.                      CRPENDING := TRUE
  304.             END (* WITH *)
  305.       END; (* WHILE *)
  306.    IF CRPENDING
  307.       THEN
  308.          WRITELN(FOUT);
  309.    CLOSE ( FOUT ) ;
  310.  WRITELN;
  311.  WRITELN;
  312.  WRITELN ( ' YOUR PRETTY PRINTED PGM IS NOW IN ',
  313.  PROGOUT );
  314. END. (* PRETTY *)
  315.