// $Header: /MeShare/Src/MODULA_2.S 9     4/17/96 16:44 Dan $

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 1991 by American Cybernetics, Inc.
*******************************************************************************/

#include LANGUAGE.SH
#include TEMPLATE.SH

#ifdef _Debug_
  #include MSGLOG.SH
#endif

void 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 1991 by American Cybernetics, Inc.
*******************************************************************************/
{
	str C_STR;          /* Word to check for indent */
	int T_COL,T_COL2;   /* Temp column positions */
	int sig_char_found,ind_count,jx;
	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)  ) {
		if(  (Cur_Char == '(')  ) {
			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;
		}
	}

	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  ) {   /* If this position is greater than the original */
		T_COL = T_COL2;       /*   then store the original */
		GOTO_COL(T_COL);       /*   and go there */
	}
	if(  NOT (At_Eol)  ) {     /* If we are not beyond the end of the line then */
		SET_INDENT_LEVEL;      /*   set the indent level */
	}

	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) & (LENGTH(C_STR) != 0) &
		(POS(C_STR,
	 ' PROCEDURE BEGIN CASE '
	 ) != 0)  ) {
			INDENT;
	} else {
		if(  (Found_Char != ';') & (T_COL != T_COL2) & (LENGTH(C_STR) != 0)
			& (POS(C_STR,
		' VAR TYPE CONST PROCEDURE BEGIN IF WHILE REPEAT LOOP WITH FOR ELSE ELSIF '
		) != 0)  ) {
			INDENT;
		} else {
	/***********************************************************************/
	/****>>> IF YOU DON'T WANT AN UNDENT AFTER 'END' THEN COMMENT OUT THE  */
	/****>>> FOLLOWING THREE LINES                                         */
			IF (C_STR == ' END ')
				UNDENT;
		}
	}
	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))  ) {
		if(  (CUR_CHAR == ')')  ) {
			LEFT;
			if(  (CUR_CHAR == '*')  ) {
				JX = SEARCH_BWD('(@*', 0);
				LEFT;
				GOTO skip_mod_noise1;
			}
			RIGHT;
			SIG_CHAR_FOUND = TRUE;
			GOTO EXIT_skip_mod;
		}

		SIG_CHAR_FOUND = TRUE;
		GOTO EXIT_skip_mod;
	}

/*  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)  ) {
		SIG_CHAR_FOUND = FALSE;
		GOTO EXIT_skip_mod;
	}
	UP;
	EOL;
	GOTO skip_mod_noise1;

EXIT_skip_mod:
	REFRESH = TRUE;
	RET;

MAC_EXIT:

}

void _ModSetX( )
/******************************************************************************
															 Multi-Edit Macro
															 05-Apr-96  11:23

  Function: Sets the Modula-2 language construct matching globals.
  Entry   : None
  Exit    : None
	Author  : Dan Hughes

							 Copyright (C) 1996 by American Cybernetics, Inc.
********************************************************************( ldh )***/
{
	Key_To_Window( Ascii( ")" ), "MODULA_2^ModCloseParen" );	 // ")" key
	if ( Length( Global_Str( "!ModMatchExtra" ) ) == 0 ) {
		// Set word begin/end characters
  	Set_Global_Str( "!ModMatchExtra",
      	"B=" + "\t ;)" +
      	"E=" + "\t ;.(" );
		// Set begin construct patterns
  	Set_Global_Str( "!ModMatchBegPat",
      	"(" +                          // ( matching
          	"B= ( " +
          	"M=" +
          	"E= ) " +
          	"X=[()]" +
      	"[" +                          // [ matching
          	"B= [ " +
          	"M=" +
          	"E= ] " +
          	"X=[\\[\\]]" +
      	"(*" +                         // (* matching
          	"B= (* " +
          	"M=" +
          	"E= *) " +
          	"X=(\\(\\*)|(\\*\\))" +
      	"IFWHILEFORCASELOOPWITHBEGINRECORDELSEELSIF" +
          	"B= IF WHILE FOR CASE LOOP WITH BEGIN RECORD " +
          	"M= ELSE ELSIF " +
          	"E= END " +
          	"X=(END)|(IF)|(WHILE)|(FOR)|(CASE)|(LOOP)|(WITH)|(BEGIN)|(RECORD)|(ELSE)|(ELSIF)" +
      	"REPEAT" +
          	"B= REPEAT " +
          	"M=" +
          	"E= UNTIL " +
          	"X=(UNTIL)|(REPEAT)" +
      	"" );
		// Set end construct patterns
  	Set_Global_Str( "!ModMatchEndPat",
      	")" +
          	"B= ) " +
          	"E= ( " +
          	"X=[()]" +
      	"]" +
          	"B= ] " +
          	"E= [ " +
          	"X=[\\[\\]]" +
      	"*)" +
          	"B= *) " +
          	"E= (* " +
          	"X=(\\(\\*)|(\\*\\))" +
      	"END" +
          	"B= END " +
          	"E= IF WHILE FOR CASE LOOP WITH BEGIN RECORD " +
          	"X=(IF)|(WHILE)|(FOR)|(CASE)|(LOOP)|(WITH)|(BEGIN)|(RECORD)|(END)" +
      	"UNTIL" +
          	"B= UNTIL " +
          	"E= REPEAT " +
          	"X=(REPEAT)|(UNTIL)" +
				"" );
	}
}  // _PasSetX

void _ModGetMatchPat( )
/******************************************************************************
															 Multi-Edit Macro
															 05-Apr-96  10:48

  Function: Called by LangDoMatch to locate and return a special pattern to
 						match for Modula-2 style languages.

  Entry   : None

  Exit    : Return_Str  - Pattern to match or "" if a special pattern not found
            g_LangInCmt - True when pattern starts in a comment

	Author	: Dan Hughes

							 Copyright (C) 1996 by American Cybernetics, Inc.
********************************************************************( ldh )***/
{
	str Special = "()[]*";
	str TStr;

  int StartInCmt;

	StartInCmt = GetStatusAtCursor( );
	if ( XPos( Cur_Char, Special, 1 ) ) {
		Mark_Pos;
		TStr = Cur_Char;
		switch ( Cur_Char ) {
			case '(' :
				Right;
				if ( Cur_Char == '*' ) {
					StartInCmt = 1;
					TStr += Cur_Char;
				}
				else {
					Left;
				}
				break;

			case ')' :
				if ( C_Col != 1 ) {
					Left;
				}
				if ( Cur_Char == '*' ) {
					StartInCmt = 1;
					TStr = Cur_Char + TStr;
				}
				else {
					Right;
				}
				break;

			case '*' :
				Right;
				if ( Cur_Char == ')' ) {
					StartInCmt = 1;
					TStr += Cur_Char;
					Pop_Mark;
					Mark_Pos;
					Left;
				}
				else {
					Left;
					Left;
					if ( Cur_Char == '(' ) {
						StartInCmt = 1;
						TStr = Cur_Char + TStr ;
						Pop_Mark;
						Mark_Pos;
					}
					else {
						TStr = '';
					}
				}
				break;
		}
		TStr = "\x7F" + TStr + "\x7F";
	}
  g_LangInCmt = StartInCmt;
  Return_Str = TStr;

}  // _ModGetMatchPat

void ModMtch( ) trans
/******************************************************************************
															 Multi-Edit Macro
															 04-Apr-96  09:55

	Function: Find matching language constructs for Modula-2 style languages.

	Entry   : /HI=1    		- Highlight block
						/RC=1    		-	Restore cursor to original position
						/LS=x    		-	Limit scope of search to x number of lines
						/NM=1				- Display no messages
						/NA=1				- No check for abort

	Exit    : Return_Int
						 -1					- Search aborted
							0         - Match found
							1         - No match found

	Author	: Dan Hughes

							 Copyright (C) 1996 by American Cybernetics, Inc.
********************************************************************( ldh )***/
{
  Return_Int = LangDoMatch( "Mod", "", MParm_Str );

}  // ModMtch

void ModCloseParen( )
/******************************************************************************
															 Multi-Edit Macro
															 09-Apr-96  15:24

	Function: Auto match the opening paren for Modula-2 style languages.
	Entry   : MParm_Str			- Additional parameters ( See LangDoMatch )
	Exit    : None
	Author  : Dan Hughes

							 Copyright (C) 1996 by American Cybernetics, Inc.
********************************************************************( ldh )***/
{
	int SavRefresh = Refresh;
	int TSearch_Highlight = 0;

	Push_Undo;
	Refresh = False;
	Text( ")" );
	if ( ( GetStatusAtCursor( ) & 0x0F ) == 0 ) {
		Left;
		if ( C_Col > 1 ) {
			Left;
			if ( Cur_Char == "*" ) {
				Right;
				goto Done;
			}
			Right;
		}
		LangDoMatch( "Mod", "", MParm_Str + "/RC=1/HI=1/LS=20" );
		TSearch_Highlight = Search_Highlight;

	Done:
		Right;
		Search_Highlight = TSearch_Highlight;
	}
	Refresh = SavRefresh;
	Pop_Undo;

}  // ModCloseParen

macro MODULE_MENU
{
  RM('USERIN^XMENU /T=1/B=1/M=Implementation module()Definition module()Module()');
  switch (return_int) {
    case 1 :
      g_tmp_last_prompt = "IMPLEMENTATION ";
      break;
    case 2 :
      g_tmp_last_prompt = "DEFINITION ";
      break;
    case 0 :
      g_tmp_abort = true;
    default :
      g_tmp_last_prompt = "";
      break;
  }
}
