Piper's Pit BBS/FTP: ibm 0010 - 0019/ibm0010-0019/ibm0010.tar/ibm0010/ME494-3.ZIP/SRC/MODULA_2.SRC

Text File | 1990-04-17 | 14.4 KB | 652 lines

$MACRO_FILE MODULA_2;
{******************************************************************************
                                                        MULTI-EDIT MACRO FILE

Name: MODULA_2

Description:    Language support for Modula-2

MOD_IND - Smart indent
MODTEMP - Template editing
MODMTCH - Construct matching

                             (C) Copyright 1989 by American Cybernetics, Inc.
******************************************************************************}

$MACRO MOD_IND;
{******************************************************************************
                                                                MULTI-EDIT MACRO

Name: MOD_IND

Description:  This macro will perform a smart indent when the <ENTER> key is
    pressed.  This macro is called by the macro CR.

                             (C) Copyright 1989 by American Cybernetics, Inc.
******************************************************************************}

    DEF_STR(C_STR);          {Word to check for indent}
    DEF_INT(T_COL,T_COL2);   {Temp column positions}
    DEF_INT(sig_char_found,ind_count,jx);
    DEF_CHAR(found_char);

    MARK_POS;
    Reg_Exp_Stat := True;
    Refresh := False;
    LEFT;
    {Check to see if we are inside a comment}
    {Don't go back farther than 20 lines in order to improve speed}
    IF Search_Bwd('{(@*}||{@*)}',20) THEN
        IF (Cur_Char = '(') THEN
            RIGHT;
            RIGHT;
            Set_Indent_Level; { this stuff below needed to be moved inside this loop }
            GOTO_MARK;        { you might check the PAS_IND because I think it has the same problem }
            Refresh := True;
            CR;
            GOTO MAC_EXIT;
        END;
    END;

    GOTO_MARK;
    MARK_POS;

    CALL skip_mod_noise1;
    FOUND_CHAR := CUR_CHAR;
    GOTO_MARK;
    REFRESH := TRUE;

    T_COL2 := C_COL;         {Store current position}
    FIRST_WORD;              {Go to the first word on the line}
    T_COL := C_COL;          {Store this position}

    IF T_COL2 < T_COL THEN   {If this position is greater than the original}
        T_COL := T_COL2;       {  then store the original}
        GOTO_COL(T_COL);       {  and go there}
    END;
    IF NOT (At_Eol) THEN     {If we are not beyond the end of the line then}
        SET_INDENT_LEVEL;      {  set the indent level}
    END;

    T_COL := C_COL;          {Store the current position}
                                                     {Get the current word, removing any extra space}
    C_STR := ' ' + REMOVE_SPACE(CAPS( GET_WORD('; (,{') )) + ' ';

    GOTO_COL(T_COL2);        {Put cursor on original position}
    CR;                      {Perform a carriage return}

                                                     {If the word is in this list, and the original
                                                            position was not on the first word then
                                                            indent}
    IF (T_COL <> T_COL2) AND (LENGTH(C_STR) <> 0) AND
        (POS(C_STR,
     ' PROCEDURE BEGIN CASE '
     ) <> 0) THEN
            INDENT;
    ELSE
        IF (Found_Char <> ';') and (T_COL <> T_COL2) and (LENGTH(C_STR) <> 0)
            AND (POS(C_STR,
        ' VAR TYPE CONST PROCEDURE BEGIN IF WHILE REPEAT LOOP WITH FOR ELSE ELSIF '
        ) <> 0) THEN
            INDENT;
        ELSE
    {*********************************************************************}
    {***>>> IF YOU DON'T WANT AN UNDENT AFTER 'END' THEN COMMENT OUT THE  }
    {***>>> FOLLOWING THREE LINES                                         }
{      IF (C_STR = ' END ') THEN
                UNDENT;
            END; }
        END;
    END;
    GOTO MAC_EXIT;

skip_mod_noise1:

{ Here we look for the nearest preceding nonblank character.  If it is a
    closing comment then we find the nearest opening comment.
    }

    IF (SEARCH_BWD('[~ ]', 1)) THEN
        IF (CUR_CHAR = ')') THEN
            LEFT;
            IF (CUR_CHAR = '*') THEN
                JX := SEARCH_BWD('(@*', 0);
                LEFT;
                GOTO skip_mod_noise1;
            END;
            RIGHT;
            SIG_CHAR_FOUND := TRUE;
            GOTO EXIT_skip_mod;
        END;

        SIG_CHAR_FOUND := TRUE;
        GOTO EXIT_skip_mod;
    END;

{ If we failed to find a nonblank character on the current line, and the
    cursor is on line 1, we failed to find a significant character; otherwise,
    we back up a line and try again. }

    IF (C_LINE = 1) THEN
        SIG_CHAR_FOUND := FALSE;
        GOTO EXIT_skip_mod;
    END;
    UP;
    EOL;
    GOTO skip_mod_noise1;

EXIT_skip_mod:
    REFRESH := TRUE;
    RET;

MAC_EXIT:

END_MACRO;

$MACRO MODTEMP;
{******************************************************************************
                                                                MULTI-EDIT MACRO

Name: MODTEMP

Description: Creates modula 2 language constructs based on a single character
    to the left of the current cursor position.

                             (C) Copyright 1989 by American Cybernetics, Inc.
******************************************************************************}

    DEF_INT(Temp_Col,Temp_Insert,Temp_Indent_Col);
    DEF_STR(Key_Chars, Tstr );
    DEF_CHAR(Temp_Char);
    Key_Chars := 'BIWFPMCRLE';
    Temp_Insert := Insert_Mode;
    If NOT (At_Eol) Then { if we ain't at the eol of the line }
        RM('MEERROR^Beeps /C=1'); { let the user know he's got stuff to the right on the line }
        Make_Message('Not at the end of the line.'); { you can take this out if you would like }
        GOTO END_OF_MAC;
    End;
    Insert_Mode := True;
    Temp_Col := C_COL;
    If (C_Col > 1) Then
        Left;
        If (Pos(Caps(Cur_Char),Key_Chars) = 0) Then
            Goto_Col(Temp_Col);
            Goto END_OF_MAC;
        End;
    ELSE
        Goto END_OF_MAC;
    End;
    Temp_Col := C_COL;

    If (Caps(Cur_Char) = 'B') Then
        Insert_Mode := False;
        Indent;
        Temp_Indent_Col := C_Col; { save current indent column position away as to be }
        Goto_Col(Temp_Col);       { indent level sensitive }
        Text('BEGIN');
        Insert_Mode := True;
        Cr;
        Cr;
        Goto_Col(Temp_Col);
        Text('END ;');
        Up;
        Goto_Col(Temp_Indent_Col);
        Goto END_OF_MAC;
    End;

    If (Caps(Cur_Char) = 'I') Then
        Insert_Mode := False;
        Indent;
        Goto_Col(Temp_Col);
        Text('IF () THEN');
        Insert_Mode := True;
        Cr;
        Cr;
        Goto_Col(Temp_Col);
        Text('END;');
        Up;
        Up;
        Goto_Col(Temp_Col + 4);
        Goto END_OF_MAC;
    End;

    If (Caps(Cur_Char) = 'E') Then
        Insert_Mode := False;
        Indent;
        Temp_Indent_Col := C_Col;
        Goto_Col(Temp_Col);
        Text('ELSE');
        Insert_Mode := True;
        Cr;
        Cr;
        Up;
        Goto_Col(Temp_Indent_Col);
        Goto END_OF_MAC;
    End;

    If (Caps(Cur_Char) = 'W') Then
        Insert_Mode := False;
        Indent;
        Goto_Col(Temp_Col);
        Text('WHILE () DO');
        Insert_Mode := True;
        Cr;
        Cr;
        Goto_Col(Temp_Col);
        Text('END;');
        Up;
        Up;
        Goto_Col(Temp_Col + 7);
        Goto END_OF_MAC;
    End;

    If (Caps(Cur_Char) = 'F') Then
        Insert_Mode := False;
        Indent;
        Goto_Col(Temp_Col);
        Text('FOR  :=  TO  DO');
        Insert_Mode := True;
        Cr;
        Cr;
        Goto_Col(Temp_Col);
        Text('END;');
        Up;
        Up;
        Goto_Col(Temp_Col + 4);
        Goto END_OF_MAC;
    End;

    If (Caps(Cur_Char) = 'P') Then
        Return_Str := '';
        RM('USERIN^QUERYBOX /T=PROCEDURE NAME?/W=40/C=' + str(wherex) +
                '/L=' + Str(wherey - 2));
        If return_int < 1 THEN
            goto END_OF_MAC;
        end;
        Insert_Mode := False;
        Indent;
        Temp_Indent_Col := C_Col;
        Goto_Col(Temp_Col);
        Text('PROCEDURE ' + return_str + '(  );');
        Insert_Mode := True;
        Cr;
        Goto_Col(Temp_Indent_Col);
        Text('BEGIN');
        Cr;
        Cr;
        Goto_Col(Temp_Indent_Col);
        Text('END ' + return_str + ';');
        Up;
        Up;
        Up;
        Goto_Col(Temp_Col + 12 + length(return_str));
        Goto END_OF_MAC;
    End;

    If (Caps(Cur_Char) = 'M') Then
        Return_Str := '';
        RM('USERIN^QUERYBOX /T=MODULE NAME?/W=40');
        If return_int < 1 THEN
            goto END_OF_MAC;
        end;
        RM('USERIN^XMENU /T=1/B=1/M=Implementation module()Definition module()Module()');
        tstr := '';
        If return_int < 1 THEN
            goto END_OF_MAC;
        end;
        If return_int = 1 then
            tstr := 'IMPLEMENTATION ';
        end;
        If return_int = 2 then
            tstr := 'DEFINITION ';
        end;

        Insert_Mode := False;
        Indent;
        Goto_Col(Temp_Col);
        Text(tstr + 'MODULE ' + return_str + ';');
        Insert_Mode := True;
        Cr;
        Cr;
        Goto_Col(Temp_Col);

        If return_int <> 2 then
            Text('BEGIN');
            Cr;
            Cr;
            Goto_Col(Temp_Col);
        end;
        Text('END ' + return_str + '.');
        Up;
        Goto_Col(1);
        Goto END_OF_MAC;
    End;

    If (Caps(Cur_Char) = 'C') Then
        Insert_Mode := False;
        Indent;
        Goto_Col(Temp_Col);
        Text('CASE  OF');
        Insert_Mode := True;
        Cr;
        Cr;
        Goto_Col(Temp_Col);
        Text('END;');
        Up;
        Up;
        Goto_Col(Temp_Col + 5);
        Goto END_OF_MAC;
    End;

    If (Caps(Cur_Char) = 'R') Then
        Insert_Mode := False;
        Indent;
        Goto_Col(Temp_Col);
        Text('REPEAT');
        Insert_Mode := True;
        Cr;
        Cr;
        Goto_Col(Temp_Col);
        Text('UNTIL ();');
        Goto_Col(Temp_Col + 7);
        Goto END_OF_MAC;
    End;

    If (Caps(Cur_Char) = 'L') Then
        Insert_Mode := False;
        Indent;
        Temp_Indent_Col := C_Col;
        Goto_Col(Temp_Col);
        If C_Col <> 1 THEN
            Left;
        END;
        If Caps(Cur_Char) = 'E' THEN
            Text('ELSIF');
            Insert_Mode := True;
            Cr;
            Goto_Col(Temp_Indent_Col);
        ELSE
            Goto_Col(Temp_Col);
            Text('LOOP');
            Insert_Mode := True;
            Cr;
            Goto_Col(Temp_Indent_Col);
            Text('IF () THEN');
            Cr;
            Indent;
            Text('EXIT;');
            Cr;
            Undent;
            Goto_Col(Temp_Indent_Col);
            Text('END;');
            Cr;
            Goto_Col(Temp_Col);
            Text('END;');
            Up;
            Up;
            Up;
            Goto_Col(Temp_Col + 6);
        END;
        Goto END_OF_MAC;
    End;

END_OF_MAC:
    Insert_Mode := Temp_Insert;
END_MACRO;

$MACRO MODMTCH TRANS;
{******************************************************************************
                                                                MULTI-EDIT MACRO

Name: MODMTCH

Description: Construct matching for Modula-2

                             (C) Copyright 1989 by American Cybernetics, Inc.
******************************************************************************}

    DEF_STR( Str1,     {Match strings}
                     EStr1,
                     T_Str, S_Str, FStr );

    DEF_INT( Direction,   {1 = search forward, 0 = backward}
                     B_Count,     {Match count.  0 = match found}
                     S_Res,       {Search results}
                     Second_Time );


    Second_Time := False;
    Refresh := False;     {Turn screen refresh off}
    Str1 := '';
    EStr1 := '';

Find_Match_Str:

    IF (Cur_Char = '(') THEN   {Setup match for '('}
        Right;
        If cur_char = '*' then
            Str1 := '(*';
            EStr1 := '*)';
            S_Str := '{(@*}||{@*)}';
        else
            Left;
            Str1 := '(';
            EStr1 := ')';
            S_Str := '[()'']';
        end;
        Direction := 1;
        GOTO Start_Match;
    END;

    IF (Cur_Char = ')') THEN   {Setup match for ')'}
        If (C_Col <> 1) then
            Left;
        end;
        If cur_char = '*' then
            Str1 := '*)';
            EStr1 := '(*';
            S_Str := '{(@*}||{@*)}';
        else
            Right;
            Str1 := ')';
            EStr1 := '(';
            S_Str := '[()'']';
        end;
        Direction := 0;
        GOTO Start_Match;
    END;

    IF At_EOL THEN     {If we are at the end of a line the go to the first word}
        First_Word;
    END;

    IF (Cur_Char = ' ') or
         (Cur_Char = '|9') or
         (Cur_Char = '|255') THEN      {If we are on a blank space then find a word}
        Word_Right;
    END;

    S_Str := '['']||{%||[|9 ;)]{END}||{IF}||{WHILE}||{FOR}||{CASE}||{LOOP}||{WITH}||{BEGIN}$||[|9 ;.(]}||{(@*}||{@*)}';

    T_Str := Caps( Get_Word(';. |9|255') );  {Get the current word}

    IF (T_Str = 'IF') OR (T_Str = 'WHILE') OR (T_Str = 'FOR') or (T_Str = 'CASE') or
         (T_STR = 'LOOP') or (T_Str = 'WITH') or (T_Str = 'BEGIN') or
         (T_Str = 'ELSE') OR (T_Str = 'ELSIF') THEN
        Str1 := 'IF WHILE FOR CASE LOOP WITH BEGIN';
        EStr1 := 'END';
        Direction := 1;
        GOTO Start_Match;
    END;

    IF T_Str = 'END' THEN
        Str1 := 'END';
        Estr1 := 'IF WHILE FOR CASE LOOP WITH BEGIN';
        Direction := 0;
        Word_Left;
        Left;
        GOTO Start_Match;
    END;

    S_Str := '['']||{%||[|9 ;)]{REPEAT}||{UNTIL}$||[|9 ;.(]}||{(@*}||{@*)}';

    IF T_Str = 'REPEAT' THEN
        Str1 := 'REPEAT';
        Estr1 := 'UNTIL';
        Direction := 1;
        GOTO Start_Match;
    END;

    IF T_Str = 'UNTIL' THEN
        Str1 := 'UNTIL';
        Estr1 := 'REPEAT';
        Direction := 0;
        Word_Left;
        Left;
        GOTO Start_Match;
    END;


    {If we didn't find a word to match the first time then try again}
    If NOT( Second_Time ) THEN
        Second_Time := True;
        First_Word;
        GOTO Find_Match_Str;
    END;

    Make_Message('NOTHING to Match');
    GOTO Macro_Exit;

Start_Match:
    Reg_Exp_Stat := True;
    Ignore_Case := false;
    B_Count := 1;
    S_Res := 1;
    Make_Message('Matching...  Press <ESC> to Stop.');
    Working;

MATCH_LOOP:   {Main loop}
                    {If the <ESC> key is pressed while matching then abort the search}
    if check_key then
        if key1 = 27 then
            Make_Message('Match Aborted.');
            goto macro_exit;
        end;
    end;

    If S_Res = 0 THEN   {If last search result was false then exit}
        GOTO Error_Exit;
    END;

    If B_Count = 0 THEN {If match count is 0 then success}
        GOTO Found_Exit;
    END;

    If Direction = 1 THEN {Perform search based on direction}
        Right;
        While NOT( At_EOL) and (Cur_CHar = '|255') DO
            Right;
        END;
        S_Res := Search_Fwd(S_Str,0);
    ELSE
        Left;
        While (Cur_CHar = '|255') or
                    (Cur_Char = '|9') DO
            Left;
        END;
        S_Res := Search_Bwd(S_Str,0);
    END;

    If S_Res = 0 THEN   {If search failed then exit}
        GOTO Macro_Exit;
    END;

    FStr := Found_Str;

    IF Length(FStr) > 2 THEN
        IF XPOS(Copy(FStr,1,1),'|9 ;()',1)  THEN  {If the first char is a space or a ;}
            FStr := Copy(FStr,2,20);         {  then eliminate it}
        END;
                                                                            {If it ended in a space, ; or . then}
        IF XPOS(Copy(FStr,Length(FStr),1),'|9 ;.()',1) THEN
            FStr := Copy(FStr,1,Length(FStr) - 1);  {eliminate that char}
        END;
    END;

                                                            {If we found the first match string then}
    IF XPOS(FStr,STR1,1) THEN
        ++B_Count;   {Inc the match count}
        GOTO Match_Loop;
    END;

    IF XPOS(FStr,ESTR1,1) THEN          {If we found the second match string then}
        --B_Count;    {  decrement the match count}
        GOTO Match_Loop;
    END;

    If Fstr = '(*' THEN
        IF Direction = 1 then
            S_Res := Search_Fwd('@*)',0);
            RIGHT;
        END;
        Goto Match_Loop;
    END;

    If Fstr = '*)' THEN
        IF Direction = 0 then
            S_Res := Search_Bwd('(@*',0);
        ELSE
            RIGHT;
        END;
        Goto Match_Loop;
    END;

    If FStr = '''''' THEN        {If we found two single quotes the skip it}
        If Direction = 1 THEN
            RIGHT;
        ELSE
            LEFT;
        END;
        GOTO Match_Loop;
    END;

                                                            {If we found a single quote then match it}
    IF FStr = '''' THEN

        Quote_Loop:

            If Direction = 1 THEN
                RIGHT;
            ELSE
                LEFT;
            END;
            IF Direction = 1 THEN
                S_Res := Search_Fwd('''',0);
            ELSE
                S_Res := Search_Bwd('''',0);
            END;
            If S_Res = 0 THEN
                GOTO Macro_Exit;
            END;
            FStr := Found_Str;
            If FStr = '''''' THEN
                GOTO Quote_Loop;
            END;
            GOTO Match_Loop;

    END;

Error_Exit:     {Go here for unsucessfull match}
    Make_Message('Match NOT Found');
    GOTO Macro_Exit;

Found_Exit:     {Go here for successfull match}
    If EStr1 = '*)' then
        right;
    end;
    Make_Message('Match Found');
Macro_Exit:
    Refresh := True;
    Redraw;
END_MACRO;