Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/TPF.ZIP/TPFCOM.PAS

Pascal/Delphi Source File | 1985-05-20 | 9.4 KB | 312 lines

{[B+]}
{*-------------------------*
 | Block Comment Character |
 *-------------------------*}

var
    Stat_Break: Integer;                {character where line can be broken}
    Stat_Blanks: Boolean;               {set if blank was last char}
    First_Input_Line: Boolean;          {set if first input line}


procedure Block_Com_Char {(Character: Char)} ;
{
! Write a character for a block comment. The comment formatting must be
! terminated with a call to adjust_block_comment. The comment is copied
! exactly, and if it will not fit within the out_line_len a message will
! be printed.
}
    begin
    if End_File then Abort(Syntax);

    if Formatting then
        if New_Input_Line and (Character = ' ') then
            begin
            if Write_Col > Out_Line_Len then Comment_Overflow;
            Print_Line(Column);
            First_Input_Line := false;
            New_Input_Line := false;
            end
        else Write_A(Character);
    end; {Block_Com_Char}


procedure Break_Stat_Comment;
{
! Break a statement comment at the last break. Assumes (stat_break <> 0)
! and (char_count - stat_break < Buf_Size)
}

    var
        Extra_Len: Integer;             {length from last break}
        Com_Indent: Integer;            {amount to indent the extra}

    begin
    Extra_Len := Char_Count - Stat_Break + 1;

    if Write_Col - Extra_Len > Max_Line_Len then Abort(Com_Format)
    else
        begin {we can at least write it}
        if Write_Col - Extra_Len > Out_Line_Len then Comment_Overflow;
        Com_Indent := Out_Line_Len - Extra_Len;
        if Com_Indent < 0 then Com_Indent := 0
        else if Com_Indent > Remark_Col then Com_Indent := Remark_Col;

        with Unwritten[Stat_Break mod Buf_Size] do
            begin
            Action_Is := Begin_Line;
            Spacing := Com_Indent;
            end;

        Current_Line := Current_Line + 1;
        Write_Col := Com_Indent + Extra_Len;
        end;
    end; {Break_Stat_Comment}


procedure Stat_Com_Char {(Character: Char)} ;
{
! Take a statement character and format it. assumes that stat_break
! and stat_blank are initialized before the first character and
! are unchanged thereafter. The procedure adjust_stat_comment must
! be called after the comment is done
}
    begin
    if End_File then Abort(Syntax);

    if Formatting then
        if Character = ' ' then
            begin

            if not Stat_Blanks then
                begin
                if (Write_Col > Out_Line_Len) and (Stat_Break <> 0) then
                    Break_Stat_Comment;
                Write_A(' ');
                Stat_Break := Char_Count;
                Stat_Blanks := true;
                end;
            end
        else
            begin
            Write_A(Character);
            Stat_Blanks := false;
            end;
    end; {Stat_Com_Char}


procedure Do_Comment(Block: Boolean; {true if block comment}
                     Init_Col: Line_Index; {starting column}
                     Init_Char: Char {starting char} );
{
! Handles all comments.
!
! Comments are split into two classes which are handled separately.
!
! Comments which begin a line are treated as "block comments" and
! are not formatted.  At most, it will be folded to fit on the
! output line.
!
! Comments which follow other statements on a line are formatted
! like any other statement.
}


    procedure Adjust_Block_Comment(Start: Integer);
    {
    ! If the comment is all on one line, adjust it to line up with
    ! the indentation if possible, otherwise just try to fit it somehow.
    ! In any case, if the comment extends beyond the allowable length,
    ! bitch about it.
    }

        var
            Com_Length: Integer;        {length of comment if on one line}
            Com_Indent: Integer;        {amount to indent comment}

        begin

        if Formatting then
            begin

            if First_Input_Line then
                begin
                Com_Length := Char_Count - Start;
                Com_Indent := Out_Line_Len - Com_Length;
                if Com_Indent < 0 then Com_Indent := 0
                else if Com_Indent > Stat_Indent then
                    Com_Indent := Stat_Indent;
                Unwritten[Start mod Buf_Size].Spacing := Com_Indent;
                Write_Col := Com_Indent + Com_Length;
                end;
            if Write_Col > Out_Line_Len then Comment_Overflow;
            end; {if formatting}
        end; {Adjust_Block_Comment}


    procedure Adjust_Stat_Comment;
    {
    ! Called after the last character of a statment comment has been
    ! written to ensure that it all fits on a line
    }
        begin

        if Formatting then
            if Write_Col > Out_Line_Len then
                if Stat_Break = 0 then
                    if Write_Col <= Max_Line_Len then Comment_Overflow
                    else Abort(Com_Format)
                else Break_Stat_Comment;
        end; {Adjust_Stat_Comment}


    procedure Block_Comment(Column: Line_Index; {starting column}
                            Init_Char: Char);
    {
    ! Format a block comment: If the comment is all on one input line
    ! it will be indented to the current statement level unless it
    ! won't fit, in which case it is shifted left until it will fit.
    ! If any part of a block comment will not fit in the output line,
    ! the output line will be extended and a message printed.
    }

        var
            Term_Char1, Term_Char2: Char;
            Com_Start: Integer;         {start of comment}

        begin
        Print_Line(Column - 1);
        Com_Start := Char_Count;
        First_Input_Line := true;

        if Init_Char = '{' then
            begin
            Term_Char1 := '}';
            Term_Char2 := '}';
            Block_Com_Char('{')
            end
        else
            begin
            Term_Char1 := '*';
            Term_Char2 := ')';
            Block_Com_Char('(');
            Block_Com_Char('*');
            end;

        Get_Char;
        if Ch = '[' then Do_Formatter_Directives(1);

        repeat
            while Ch <> Term_Char1 do
                begin
                Block_Com_Char(Ch);
                Get_Char;
                end;

            if Ch = '*' then
                begin
                Get_Char;
                if Ch <> ')' then Block_Com_Char('*');
                end;
        until Ch = Term_Char2;

        if Ch = '}' then Block_Com_Char('}')
        else
            begin
            Block_Com_Char('*');
            Block_Com_Char(')');
            end;

        if Block then Adjust_Block_Comment(Com_Start);
        end; {Block_Comment}


    procedure Stat_Comment(Init_Char: Char);
    {
    ! Format a statement comment: These are inserted in the line at the place
    ! found, and subsequent lines are indented to the start of the comment. If
    ! the start of the comment is too far to the right, it will be indented on
    ! the next line. Text will be moved as necessary to fill lines. All breaks
    ! will be at blanks, and if it is not possible to break a comment properly
    ! the output line will be extended and a message printed
    }

        var
            Term_Char1, Term_Char2: Char;

        begin
        {initialize stat_com_char}
        Stat_Break := 0;
        Stat_Blanks := false;
        Indent_Plus(Write_Col + Comment_Spaces + 1 - Indent);

        if Indent > Three_Fourth_Line then
            begin
            Undent;
            Indent_Plus(Tab_Spaces);
            end;

        if Write_Col < Out_Line_Len - Comment_Spaces - 1 then
            if In_Declaration then
                if (Remark_Col - Write_Col) > Comment_Spaces then
                    Space(Remark_Col - Write_Col)
                else Space(Comment_Spaces)
            else Space(Comment_Spaces);

        if Init_Char = '{' then
            begin
            Term_Char1 := '}';
            Term_Char2 := '}';
            Stat_Com_Char('{')
            end
        else
            begin
            Term_Char1 := '*';
            Term_Char2 := ')';
            Stat_Com_Char('(');
            Stat_Com_Char('*');
            end;

        Get_Char;
        if Ch = '[' then Do_Formatter_Directives(2);

        repeat
            while Ch <> Term_Char1 do
                begin
                Stat_Com_Char(Ch);
                Get_Char;
                end;

            if Ch = '*' then
                begin
                Get_Char;
                if Ch <> ')' then Stat_Com_Char('*');
                end;
        until Ch = Term_Char2;

        if Ch = '}' then Stat_Com_Char('}')
        else
            begin
            Stat_Com_Char('*');
            Stat_Com_Char(')');
            end;

        Adjust_Stat_Comment;
        Undent;
        Blank_Lines := 0;
        New_Input_Line := false;
        end; {Stat_Comment}

    begin {Do_Comment}
    New_Input_Line := false;
    if Block then Block_Comment(Init_Col, Init_Char)
    else Stat_Comment(Init_Char);
    Formatting := New_Formatting;
    New_Input_Line := false;
    Get_Char;
    while (Ch = ' ') and not New_Input_Line do Get_Char;
    if Formatting and New_Input_Line then End_Line := true;
    Symbol_Found := false;
    Last_Sym := Comment;
    end; {Do_Comment}