(*$R-,L-*)
PROGRAM INDENT(SOURCE, INPUT, OUTPUT);
CONST
  SMALLINDENT=2; MIDINDENT=2; LARGEINDENT=4;
TYPE
  STATETYPE =
      (OPENER, MIDDLER, CLOSER, PRAGMENT, DOER, QUOTE, COLON, GO, STROP, OTHER);
  CLAUSETYPE =
      (BRIEF, CONDCL, CASECL, CLOSEDCL, LOOPCL, INDEXER, ROUTINE, JUMP,
              EXIT, SEMICOMMA, STRING, HASH, CO, COMMENT, PR, PRAGMAT, UPPER, POINT, ANY);
  TREEP=^TREE;
  TREE=RECORD
  (*TREE TO HOLD RESERVED WORD DICTIONARY*)
    C: CHAR;
    LEFT, RIGHT, NEXT: TREEP;
    TIP: BOOLEAN;
    ST: STATETYPE; CL: CLAUSETYPE;
    END;
  STACKP=^STACK;
  STACK=PACKED RECORD
    C: CLAUSETYPE; G: BOOLEAN;
    NEXT: STACKP
    END;
  ALFA=PACKED ARRAY [1..10] OF CHAR;
VAR
  SOURCE: TEXT;
  ROOT: TREEP;
  TOS: STACKP;
  VETTEDCHARACTER: RECORD
    WORD: PACKED ARRAY [1..80] OF CHAR; (*THE LONGEST CONCEIVABLE BOLDWORD!*)
    INDEX: 0..80;
    END;
  STARTOFLINE,
  LINENUMBERS: BOOLEAN; (*TRUE IFF THE SOURCE TEXT INCLUDES LINE NUMBERS*)
  I: INTEGER;
  INDENT, (*EXPECTED INDENT FOR SUBSEQUENT LINES*)
  TEMPINDENT: INTEGER; (*INDENT FOR CURRENT LINE*)
  INSTRAGMENT: BOOLEAN;
  STROPSTATE: (INPOINT, INUPPER, INPRAGP, INPRAGUP);
  GONEON: BOOLEAN; (*TRUE IFF THE LAST TOKEN WAS AN OPENER OR A MIDDLER*)
(**)
(**)
(**)
PROCEDURE SETUPTREE;
(*TO CREATE THE DICTIONARY*)
  PROCEDURE INSERT(WORD: ALFA; S: STATETYPE; B: CLAUSETYPE);
    VAR TREEPTR: TREEP; INDEX: INTEGER; FOUND: BOOLEAN;
      BEGIN TREEPTR := ROOT; INDEX := 1;
      WHILE WORD[INDEX]<>' ' DO
        BEGIN
        WITH TREEPTR^ DO
          BEGIN
          IF TREEPTR^.NEXT=NIL THEN
            BEGIN NEW(NEXT); WITH NEXT^ DO
              BEGIN C := WORD[INDEX];
              LEFT := NIL; RIGHT := NIL; TIP := FALSE; NEXT := NIL
              END
            END;
          TREEPTR := NEXT
          END;
        FOUND := FALSE;
        WHILE NOT FOUND DO WITH TREEPTR^ DO
          IF WORD[INDEX]<C THEN
            BEGIN
            IF LEFT=NIL THEN
              BEGIN NEW(LEFT); WITH LEFT^ DO
                BEGIN C := WORD[INDEX];
                LEFT := NIL; RIGHT := NIL; TIP := FALSE; NEXT := NIL
                END;
              FOUND := TRUE
              END;
            TREEPTR := LEFT
            END
          ELSE IF WORD[INDEX]>C THEN
            BEGIN
            IF RIGHT=NIL THEN
              BEGIN NEW(RIGHT); WITH RIGHT^ DO
                BEGIN C := WORD[INDEX];
                LEFT := NIL; RIGHT := NIL; TIP := FALSE; NEXT := NIL
                END;
              FOUND := TRUE
              END;
            TREEPTR := RIGHT
            END
          ELSE FOUND := TRUE;
        INDEX := INDEX+1
        END;
      WITH TREEPTR^ DO
        BEGIN TIP := TRUE; ST := S; CL := B END
      END (*INSERT*);
(**)
    BEGIN (*SETUPTREE*)
    NEW(ROOT); ROOT^.NEXT := NIL;
    INSERT('(         ', OPENER  , BRIEF    );
    INSERT('IF        ', OPENER  , CONDCL   );
    INSERT('if        ', OPENER  , CONDCL   );
    INSERT('CASE      ', OPENER  , CASECL   );
    INSERT('case      ', OPENER  , CASECL   );
    INSERT('BEGIN     ', OPENER  , CLOSEDCL );
    INSERT('begin     ', OPENER  , CLOSEDCL );
    INSERT('[         ', OPENER  , INDEXER  );
    INSERT('!         ', MIDDLER , BRIEF    );
    INSERT('THEN      ', MIDDLER , CONDCL   );
    INSERT('then      ', MIDDLER , CONDCL   );
    INSERT('IN        ', MIDDLER , CASECL   );
    INSERT('in        ', MIDDLER , CASECL   );
    INSERT('ELIF      ', MIDDLER , CONDCL   );
    INSERT('elif      ', MIDDLER , CONDCL   );
    INSERT('ELSE      ', MIDDLER , CONDCL   );
    INSERT('else      ', MIDDLER , CONDCL   );
    INSERT('OUSE      ', MIDDLER , CASECL   );
    INSERT('ouse      ', MIDDLER , CASECL   );
    INSERT('OUT       ', MIDDLER , CASECL   );
    INSERT('out       ', MIDDLER , CASECL   );
    INSERT('EXIT      ', MIDDLER , EXIT     );
    INSERT('exit      ', MIDDLER , EXIT     );
    INSERT(';         ', MIDDLER , SEMICOMMA);
    INSERT(',         ', MIDDLER , SEMICOMMA);
    INSERT(')         ', CLOSER  , BRIEF    );
    INSERT('FI        ', CLOSER  , CONDCL   );
    INSERT('fi        ', CLOSER  , CONDCL   );
    INSERT('ESAC      ', CLOSER  , CASECL   );
    INSERT('esac      ', CLOSER  , CASECL   );
    INSERT('END       ', CLOSER  , CLOSEDCL );
    INSERT('end       ', CLOSER  , CLOSEDCL );
    INSERT(']         ', CLOSER  , INDEXER  );
    INSERT('#         ', PRAGMENT, HASH     );
    INSERT('CO        ', PRAGMENT, CO       );
    INSERT('co        ', PRAGMENT, CO       );
    INSERT('COMMENT   ', PRAGMENT, COMMENT  );
    INSERT('comment   ', PRAGMENT, COMMENT  );
    INSERT('PR        ', PRAGMENT, PR       );
    INSERT('pr        ', PRAGMENT, PR       );
    INSERT('PRAGMAT   ', PRAGMENT, PRAGMAT  );
    INSERT('pragmat   ', PRAGMENT, PRAGMAT  );
    INSERT('FOR       ', DOER    , LOOPCL   );
    INSERT('for       ', DOER    , LOOPCL   );
    INSERT('FROM      ', DOER    , LOOPCL   );
    INSERT('from      ', DOER    , LOOPCL   );
    INSERT('BY        ', DOER    , LOOPCL   );
    INSERT('by        ', DOER    , LOOPCL   );
    INSERT('TO        ', DOER    , LOOPCL   );
    INSERT('to        ', DOER    , LOOPCL   );
    INSERT('WHILE     ', DOER    , LOOPCL   );
    INSERT('while     ', DOER    , LOOPCL   );
    INSERT('DO        ', DOER    , LOOPCL   );
    INSERT('do        ', DOER    , LOOPCL   );
    INSERT('OD        ', CLOSER  , LOOPCL   );
    INSERT('od        ', CLOSER  , LOOPCL   );
    INSERT('GO        ', GO      , JUMP     );
    INSERT('go        ', GO      , JUMP     );
    INSERT('"         ', QUOTE   , STRING   );
    INSERT('UPPER     ', STROP   , UPPER    );
    INSERT('upper     ', STROP   , UPPER    );
    INSERT('POINT     ', STROP   , POINT    );
    INSERT('point     ', STROP   , POINT    );
      (*':' AFTER BOLD , COLON   , ROUTINE  ); *)
    END;
(**)
(**)
PROCEDURE PUSH(CL: CLAUSETYPE);
  VAR TEMP: STACKP;
    BEGIN TEMP := TOS; NEW(TOS); WITH TOS^ DO
      BEGIN C := CL; G := GONEON; NEXT := TEMP END
    END;
(**)
(**)
PROCEDURE POP;
  VAR TEMP: STACKP;
    BEGIN
    IF NOT GONEON AND NOT INSTRAGMENT THEN INDENT := INDENT-MIDINDENT;
    TEMP := TOS; GONEON := TOS^.G; TOS := TOS^.NEXT; DISPOSE(TEMP)
    END;
(**)
(**)
PROCEDURE VET(VAR SOURCE: TEXT);
(*MOVES NEXT INTERESTING TOKEN TO VETTED CHARACTER,
  AND SETS INDENT AND TEMPINDENT ACCORDINGLY*)
  VAR TREEPTR: TREEP;
      CH: CHAR;
      STATE: STATETYPE;
      CLAUSE: CLAUSETYPE;
      BOLD, FOUND: BOOLEAN;
(**)
  PROCEDURE GAP(VAR SOURCE: TEXT);
  (*ENSURE THAT AT LEAST (SMALLINDENT-1) BLANKS ARE PRESENT IN OUTPUT*)
    VAR I: INTEGER;
      BEGIN
      I := SMALLINDENT-1;
      WHILE NOT EOLN(SOURCE) AND (SOURCE^=' ') AND (I>0) DO
        BEGIN GET(SOURCE); I := I-1 END;
      IF NOT EOLN(SOURCE) THEN
        FOR I := 2 TO SMALLINDENT DO WITH VETTEDCHARACTER DO
          BEGIN WORD[I] := ' '; INDEX := I END
      END;
(**)
  PROCEDURE CHECK(CLAUSE: CLAUSETYPE);
      BEGIN WITH TOS^ DO
        IF C<>CLAUSE THEN (*ATTEMPT TO FIX BRACKETS MISMATCH*)
          IF NEXT^.C=CLAUSE THEN (*ASSUME CLOSER WAS OMITTED*)
            BEGIN
            IF C IN [BRIEF, INDEXER] THEN INDENT := INDENT-SMALLINDENT
            ELSE INDENT := INDENT-LARGEINDENT;
            POP;
            IF GONEON THEN
              BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END
            END
          ELSE (*ASSUME OPENER WAS OMITTED*)
            BEGIN
            IF CLAUSE IN [BRIEF, INDEXER] THEN INDENT := INDENT+SMALLINDENT
            ELSE INDENT := INDENT+LARGEINDENT;
            IF NOT GONEON THEN
              BEGIN GONEON := TRUE; INDENT := INDENT-MIDINDENT END;
            PUSH(CLAUSE)
            END
      END;
(**)
    BEGIN (*VET*)
    (*ASSERT: (SOURCE^ IN [(!)[],.#";]) OR (UPPER & SOURCE^ IN [A..Z]) OR INPRAGMAT*)
    CH := SOURCE^;
    TEMPINDENT := INDENT;
    VETTEDCHARACTER.INDEX := 0;
    CASE STROPSTATE OF
      INPOINT:          BOLD := CH='.';
      INUPPER:          BOLD := CH IN ['.','A'..'Z'];
      INPRAGUP,INPRAGP: BOLD := CH IN ['.','A'..'Z','a'..'z'];
      END;
    IF CH='.' THEN WITH VETTEDCHARACTER DO
      BEGIN INDEX := 1; WORD[1] := '.'; GET(SOURCE); CH := SOURCE^ END;
    TREEPTR := ROOT^.NEXT; FOUND := FALSE;
    WHILE (TREEPTR<>NIL) AND NOT FOUND DO WITH TREEPTR^ DO
      IF C=CH THEN WITH VETTEDCHARACTER DO
        BEGIN
        INDEX := INDEX+1; WORD[INDEX] := CH;
        GET(SOURCE); CH := SOURCE^;
        IF BOLD THEN
          CASE STROPSTATE OF
            INPRAGUP,INPRAGP,INPOINT: FOUND := NOT(CH IN ['A'..'Z', 'a'..'z']) AND TIP;
            INUPPER: FOUND := NOT(CH IN ['A'..'Z']) AND TIP;
            END
        ELSE FOUND := TIP;
        IF NOT FOUND THEN TREEPTR := NEXT
        END
      ELSE IF CH<C THEN TREEPTR := LEFT
      ELSE TREEPTR := RIGHT;
    IF FOUND THEN WITH TREEPTR^ DO
      BEGIN STATE := ST; CLAUSE := CL END
    ELSE WITH VETTEDCHARACTER DO
      BEGIN
      IF BOLD THEN
        WHILE (CH IN ['A'..'Z', 'a'..'z']) DO
          (*ABSORB REMAINDER OF UNRECOGNIZED BOLDWORD*)
          BEGIN INDEX := INDEX+1; WORD[INDEX] := CH; GET(SOURCE); CH := SOURCE^ END
      ELSE
        BEGIN INDEX := INDEX+1; WORD[INDEX] := CH; GET(SOURCE); CH := SOURCE^ END;
      IF (CH=':') AND NOT INSTRAGMENT THEN WITH VETTEDCHARACTER DO
        (*START OF ROUTINE-TEXT*)
        BEGIN STATE := COLON; CLAUSE := ROUTINE;
        INDEX := INDEX+1; WORD[INDEX] := CH; GET(SOURCE)
        END
      ELSE BEGIN STATE := OTHER; CLAUSE := ANY END
      END;
(**)
    IF INSTRAGMENT THEN
      IF (CLAUSE=TOS^.C) THEN
        (*MATCHING CLOSE-STRAGMENT-TOKEN FOUND*)
        BEGIN
        IF STROPSTATE IN [INPRAGUP,INPRAGP] THEN
          STROPSTATE := PRED(PRED(STROPSTATE));
        POP;
        INSTRAGMENT := FALSE;
        IF CLAUSE=HASH THEN INDENT := INDENT-SMALLINDENT
        ELSE IF CLAUSE<>STRING THEN INDENT := INDENT-LARGEINDENT;
        TEMPINDENT := INDENT
        END
      ELSE IF (STROPSTATE IN [INPRAGUP,INPRAGP]) AND (STATE=STROP) THEN
        IF CLAUSE=UPPER THEN STROPSTATE := INPRAGUP ELSE STROPSTATE := INPRAGP
      ELSE (*NO ACTION*)
    ELSE (*NOT INSTRAGMENT*)
      BEGIN
      IF STATE IN [MIDDLER, CLOSER] THEN (*MAYBE END OF ROUTINE-TEXT*)
        WHILE TOS^.C=ROUTINE DO
          BEGIN
          POP; INDENT := INDENT-SMALLINDENT;
          IF GONEON THEN
            BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END
          END;
(**)
      IF STATE=GO THEN (*.GO OF .GO .TO*)
        BEGIN PUSH(JUMP); STATE := OTHER END
      ELSE IF STATE=DOER THEN (*CHANGE IT TO MIDDLER OR OPENER*)
        IF TOS^.C=JUMP THEN (*.TO OF .GO .TO*)
          BEGIN POP; STATE := OTHER END
        ELSE IF (TOS^.C=LOOPCL) AND NOT GONEON THEN STATE := MIDDLER
        ELSE STATE := OPENER;
(**)
      IF STATE=COLON THEN (*START OF ROUTINE-TEXT*)
        BEGIN
        IF NOT GONEON THEN
          BEGIN GONEON := TRUE; INDENT := INDENT-MIDINDENT END;
        PUSH(CLAUSE);
        INDENT := INDENT+SMALLINDENT
        END
      ELSE IF STATE=OPENER THEN (*START OF A NEW INDENT*)
        BEGIN
        PUSH(CLAUSE);
        IF CLAUSE IN [BRIEF, INDEXER] THEN
          BEGIN INDENT := INDENT+SMALLINDENT; IF STARTOFLINE THEN GAP(SOURCE) END
        ELSE INDENT := INDENT+LARGEINDENT;
        GONEON := TRUE
        END
      ELSE IF STATE=MIDDLER THEN
        BEGIN
        IF NOT (CLAUSE IN [EXIT, SEMICOMMA]) THEN CHECK(CLAUSE);
        IF NOT GONEON THEN
          BEGIN GONEON := TRUE; INDENT := INDENT-MIDINDENT END;
        IF CLAUSE=SEMICOMMA THEN
          BEGIN TEMPINDENT := INDENT-SMALLINDENT; GAP(SOURCE) END
        ELSE IF TOS^.C=BRIEF THEN
          (* ! OR !: OR .EXIT AFTER ( *)
          BEGIN TEMPINDENT := INDENT-SMALLINDENT;
          IF STARTOFLINE AND (SOURCE^<>':') AND (CLAUSE<>EXIT) THEN GAP(SOURCE)
          END
        ELSE TEMPINDENT := INDENT-LARGEINDENT
        END
      ELSE IF STATE=CLOSER THEN (*END OF INDENT*)
        BEGIN
        CHECK(CLAUSE); POP;
        IF CLAUSE IN [BRIEF, INDEXER] THEN INDENT := INDENT-SMALLINDENT
        ELSE INDENT := INDENT-LARGEINDENT;
        TEMPINDENT := INDENT;
        IF GONEON THEN
          BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END
        END
      ELSE IF STATE=PRAGMENT THEN
        BEGIN
        TEMPINDENT := INDENT;
        PUSH(CLAUSE);
        INSTRAGMENT := TRUE;
        IF CLAUSE IN [PR,PRAGMAT] THEN
          STROPSTATE := SUCC(SUCC(STROPSTATE));
        IF CLAUSE=HASH THEN
          BEGIN INDENT := INDENT+SMALLINDENT; IF STARTOFLINE THEN GAP(SOURCE) END
        ELSE INDENT := INDENT+LARGEINDENT
        END
      ELSE IF STATE=QUOTE THEN
        BEGIN
        IF GONEON THEN
          BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END;
        PUSH(STRING);
        INSTRAGMENT := TRUE
        END
      ELSE (*STATE=OTHER*)
        IF GONEON THEN
          BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END
      END
    END (*OF VET*);
(**)
(**)
PROCEDURE MAIN(VAR SOURCE: TEXT);
  VAR I: INTEGER;
    BEGIN
    INDENT := 0; INSTRAGMENT := FALSE;
    STROPSTATE := INUPPER; (*THE DEFAULT is UPPER*)
    GONEON := TRUE;
    SETUPTREE;
    LINENUMBERS := SOURCE^ IN ['0'..'9'];
    TOS := NIL; PUSH(ANY); PUSH(ANY);
    WHILE NOT EOF(SOURCE) DO
      BEGIN
      WHILE EOLN(SOURCE) DO BEGIN GET(SOURCE); WRITELN(OUTPUT) END;
        BEGIN
        STARTOFLINE := TRUE;
        IF LINENUMBERS THEN
          BEGIN
          WHILE SOURCE^ IN ['0'..'9'] DO
            BEGIN WRITE(OUTPUT, SOURCE^); GET(SOURCE) END;
          IF NOT EOLN(SOURCE) AND (SOURCE^=' ') THEN (*FIRST BLANK AFTER LINE NUMBER IS OBLIGATORY*)
            BEGIN WRITE(OUTPUT, ' '); GET(SOURCE) END
          END;
        IF TOS^.C=STRING THEN
          (*DO NOT TINKER WITH BLANKS INSIDE STRING-DENOTATIONS*)
          BEGIN
          WHILE NOT EOLN(SOURCE) AND (SOURCE^=' ') DO
            BEGIN WRITE(OUTPUT, ' '); GET(SOURCE) END;
            STARTOFLINE := FALSE
            END
        ELSE WHILE NOT EOLN(SOURCE) AND (SOURCE^=' ') DO
            GET(SOURCE); (*GET RID OF EXISTING INDENTATION*)
        WHILE NOT EOLN(SOURCE) DO
          BEGIN
          IF (SOURCE^ IN ['(','!',')','[',']',',','.','#','"',';']) OR
             ((STROPSTATE<>INPOINT) AND (SOURCE^ IN ['A'..'Z'])) OR
             (STROPSTATE IN [INPRAGUP,INPRAGP]) THEN
            (*CHARACTER WHICH MIGHT AFFECT INDENTATION*)
            BEGIN
            VET(SOURCE);
            IF STARTOFLINE THEN FOR I := 1 TO TEMPINDENT DO WRITE(OUTPUT, ' ');
            WITH VETTEDCHARACTER DO
              FOR I := 1 TO INDEX DO WRITE(OUTPUT, WORD[I])
            END
          ELSE
            BEGIN
            IF STARTOFLINE THEN FOR I := 1 TO INDENT DO WRITE(OUTPUT, ' ');
            IF (SOURCE^<>' ') AND NOT INSTRAGMENT AND GONEON THEN
              (*PREPARE TO INDENT ANY CONTINUATION LINE*)
              BEGIN GONEON := FALSE; INDENT := INDENT+MIDINDENT END;
            WRITE(OUTPUT, SOURCE^); GET(SOURCE);
            END;
          STARTOFLINE := FALSE
          END;
        GET(SOURCE); WRITELN(OUTPUT)
        END;
      END;
    END;
(**)
FUNCTION ARGC: INTEGER; EXTERN;
(**)
BEGIN (*INDENT*)
IF ARGC=1 THEN
  MAIN(INPUT)
ELSE
  BEGIN
  RESET(SOURCE);
  MAIN(SOURCE);
  END;
(*$G-*)
END.
