TeslaRel410/sda4/BRIEF/MACROS/MODULA2.CB

/*
**		BRIEF -- Basic Reconfigurable Interactive Editing Facility
**
**		Written by Dave Nanian and Michael Strickman.
**
**    History:
**		12/10/90 Jim Rodriquez - move assign_to_keys from _init macro
**										 to smart_first macro to conserve
**										 memory.
*/

/*
**
**		modula2.cb:
**
**		Smart indenting and template editing for Modula-2.
**
*/

#define FALSE			  0
#define TRUE			  1

#define MIN_ABBREV	  1

#define MOD_SKIP_PAT   "{{(\\*+{[~*]|{[~(]\\*}}@\\*)}|[ \xc\t\n]}@"

#define ABBR_LIST_1 	  "~BEGIN~CASE~CONST~DEFINITION~ELSE~EI~ELSIF~EXPORT~FOR~FROM~IF~IMPLEMENTATION"
#define ABBR_LIST_2	  "~IMPORT~LOOP~MODULE~PROCEDURE~REPEAT~RETURN~TYPE~UNTIL~VAR~WHILE~WITH~"
#define TERMINAL_LIST  "~ELSE~ELSIF~THEN~DO~OF~REPEAT~LOOP~RECORD~"
#define BLOCK_LIST	  "BEG~MOD~REC~CAS~IF~FOR~LOO~WHI~WIT~REP"
#define CASE_POS		  13

#define MAX_COL		  20736
#define NEG_MAX_COL	  -20736

extern void slide_in ();
extern open_line ();
extern int .c_previous_word ();
extern int .c_next_word ();

/*
** 	Function Prototypes
*/

string .mod_smart_first (~int, ~int, ~int);
string .mod_template_first (~int, ~int, ~int, ~int);
string .def_smart_first (~int, ~int, ~int);
string .def_template_first (~int, ~int, ~int, ~int);
void 	 .mod_indent (~int);
int 	 .mod_indent_level (~int);
void   .mod_first_nonwhite ();
int	 .mod_outdent_to_match (string, int, string);
void   .mod_abbrev ();
void   .mod_reindent (string, int);
void   .mod_expand_block (string, int);
void   .mod_expand_pair (string);
int	 .mod_next_word ();
int 	 .mod_previous_word ();

/*
**		Allocate the global variables and set up the keymaps.
*/

int	_mod_smart,
		_mod_template,
		_mod_alt_template,
		_mod_indent_block,
		_mod_indent_close,
		_mod_indent_first,
		_mod_min_abbrev;


/*
**		Turn on smart indenting for Modula-2.	This macro is designed to
**	be run the first time a file is edited, but may also be run from
**	the command line.
**
**	Parameters:
**		0 -- TRUE if the body of a procedure should be indented.
**		1 -- TRUE if the END of a block (but not a procedure, module,
**				or RECORD) should be indented.  Also applies to UNTIL.
**		2 -- TRUE if the outermost BEGIN/END of a procedure, and the
**			declarations associated with a procedure, should be indented.
**
**	Defaults: 1 0 0
*/
string .def_smart_first (~int, ~int, ~int)
{
	use_local_keyboard (_mod_smart);
	_mod_indent_block = TRUE;
	_mod_indent_close = FALSE;
	_mod_indent_first = FALSE;

	get_parm (0, _mod_indent_block);
	get_parm (1, _mod_indent_close);
	get_parm (2, _mod_indent_first);
	returns ("");
}
string  .def_template_first (~int, ~int, ~int, ~int)
{
	_mod_indent_block = TRUE;
	_mod_indent_close = FALSE;
	_mod_indent_first = FALSE;
	_mod_min_abbrev = MIN_ABBREV;

	get_parm (0, _mod_indent_block);
	get_parm (1, _mod_indent_close);
	get_parm (2, _mod_indent_first);
	get_parm (3, _mod_min_abbrev);

	if (_mod_min_abbrev == 0)
		{
		use_local_keyboard (_mod_alt_template);
		_mod_min_abbrev = 1;
		}
	else
		use_local_keyboard (_mod_template);

	returns ("");
}

string .mod_smart_first (~int, ~int, ~int)
{
   if (first_time())
   {
	   keyboard_push ();
	   assign_to_key ("<Enter>", ".mod_indent");
	   assign_to_key ("<Tab>", "slide_in");
	   assign_to_key ("<Shift-Tab>", "slide_out");
	   _mod_smart = inq_keyboard ();
	   keyboard_pop (1);
   }
	use_local_keyboard (_mod_smart);
	_mod_indent_block = TRUE;
	_mod_indent_close = FALSE;
	_mod_indent_first = FALSE;

	get_parm (0, _mod_indent_block);
	get_parm (1, _mod_indent_close);
	get_parm (2, _mod_indent_first);
	returns ("");
}

/*
**		Turn on template editing for Modula-2.  This macro is designed to
**	be run the first time a file is edited, but may also be run from
**	the command line.
**
**	Parameters:
**		0 - 2 are the same as for smart indenting.
**		3 -- the minimum length of abbreviations that should be expanded.
**			For example, if this is 2, wh<Space> will expand to a WHILE
**			loop, and wi<Space> will expand to a WITH block, but w<Space>
**			will be left alone.	Set this parameter to 0 if you want
**			to selectively expand templates by pressing <Tab>.
**
**	Defaults:  1 0 0 1
*/

string  .mod_template_first (~int, ~int, ~int, ~int)
{
	_mod_indent_block = TRUE;
	_mod_indent_close = FALSE;
	_mod_indent_first = FALSE;
	_mod_min_abbrev = MIN_ABBREV;

	get_parm (0, _mod_indent_block);
	get_parm (1, _mod_indent_close);
	get_parm (2, _mod_indent_first);
	get_parm (3, _mod_min_abbrev);

   if (first_time())
   {
	   keyboard_push ();
	   assign_to_key ("<Enter>", ".mod_indent");
	   assign_to_key ("<Tab>", ".mod_abbrev");
	   assign_to_key ("<Shift-Tab>", "slide_out");
	   assign_to_key ("<Ctrl-s>", "just_space");
	   _mod_alt_template = inq_keyboard ();
	   keyboard_pop (1);
	   keyboard_push ();
	   assign_to_key ("<Enter>", ".mod_indent");
	   assign_to_key ("<Tab>", "slide_in");
	   assign_to_key ("<Shift-Tab>", "slide_out");
	   assign_to_key ("<Space>", ".mod_abbrev");
	   assign_to_key ("<Ctrl-s>", "just_space");
	   _mod_template = inq_keyboard ();
	   keyboard_pop (1);
   }
	if (_mod_min_abbrev == 0)
		{
		use_local_keyboard (_mod_alt_template);
		_mod_min_abbrev = 1;
		}
	else
		use_local_keyboard (_mod_template);
	returns ("");
}


/*
**	These definitions are used as Modula-2 "language sensitive" word patterns
*/

int .mod_next_word ()
{
	returns (.c_next_word ());
}

int .mod_previous_word ()
{
	returns (.c_previous_word ());
}

/*
**		.mod_indent:
**
**		This macro does syntax-sensitive indenting ("smart indenting") for
**	Modula-2 language files.  It handles most common constructs, except
**	for nested comments.
**
**	Parameters:
**		0 -- if TRUE, the line is reindented if necessary, but the line
**			is never split, no newline is inserted, and the cursor is left
**			at the end of the line.
*/

void .mod_indent (~int)
{
	int	curr_line, 					//	Line cursor is on when called.
			code_line, 					//	Line where last code char is found.
			code_indent_level,		//	Current indent level, in tab stops.
			prev_indent_level,		//	Indent level of previous line.
			code_trail,					//	The last code character.
			prev_trail,					//	Last code char before code_line.
			scratch,						//	Temporary integer.
			match_indented;			//	Was keyword indented extra level?

	string	following_string,		//	Remainder of line being split.
				code_text, 				//	Trimmed text of code line.
				token,					//	Tokenized version of line.
				prev_text; 				//	Trimmed text of previous line.

	/*
	**		Initialize.
	*/

	inq_position (curr_line, NULL);
	code_trail = prev_trail = '\;';

	/*
	**		If we're in overstrike mode, we act as if we were at the
	**	end of the line when the command was invoked.
	**
	**		If we're in insert mode, we may have to split the line.
	*/

	if (!inq_mode ())
		end_of_line ();

	/*
	**		If line is being split, cut text to following_string.
	**	Leave all trailing whitespace except the newline.
	*/

	else if (read (1) != "\n")
		{
		following_string = ltrim (read ());
		following_string = substr (following_string, 1, strlen (following_string) - 1);
		delete_to_eol ();
		}
	/*
	**		Find the last "code" character; skip back over whitespace and
	**	comments until we get something different.  The cursor will be
	**	left on the next character from the "different" one; we do a
	**	(prev_char) to get to the code character.  (If it fails, we're
	**	at the top of the buffer.)
	*/

	search_back (MOD_SKIP_PAT, -2);

	/*
	**		Remember which line we found the code character on.  Classify
	**	the code character by looking it up in a string, and save
	**	a "tokenized" version of the whole line.
	*/

	if (prev_char ())
		{
		/*		
		**		We save the identity of the last code character on
		**	the "code line".
		*/

		inq_position (code_line);
		code_trail = atoi (read (1), 0);

		/*
		**		Find the first non-white character on the line, so
		**	we may determine its indenting level.	Save the
		**	text of the line for later parsing.
		*/

		.mod_first_nonwhite ();
		code_indent_level = .mod_indent_level ();
		code_text = trim (read ());

		/*
		**		Find the last code line before this, and read information
		**	about it.
		*/

		if (up ())
			{
			end_of_line ();

			if (search_back (MOD_SKIP_PAT, -2) && prev_char ())
				{
				prev_trail = atoi (read (1), 0);
				.mod_first_nonwhite ();
				prev_indent_level = .mod_indent_level ();
				prev_text = trim (read ());
				}
			}

		/*
		**		Get the first token on the code line.	This assumes
		**	that tokens are separated by spaces.
		*/

		token = substr (code_text, 1, index (code_text + " ", " ") - 1);
		}
	/*
	**		Move to the beginning of the line the cursor was originally on.
	**	Occasionally, we have to adjust its indent level.	However,
	**	if the line contains no code, we don't need to worry about it.
	*/

	move_abs (curr_line, 1);

	if (code_line == curr_line)

		/*
		**		We align the first BEGIN of a procedure, as well as
		**	declarations, with the procedure declaration above.
		**	If _mod_indent_first is TRUE, we indent one level right
		**	of the declaration.	We leave the positioning of nested
		**	procedures up to the user, since we can't distinguish
		**	them from procedures in the definition module.
		*/

		switch (token)
			{
			case "BEGIN":
			case "VAR":
			case "TYPE":
			case "CONST":
			case "FROM":
			case "IMPORT":
			case "EXPORT":
				{
				/*
				**		By default, we will align this line with the last.
				*/

				code_line = prev_indent_level;

				switch (substr (prev_text, 1, index (prev_text + " ", " ") - 1))
					{
					/*
					**		The default works for PROCEDURE and MODULE
					**	unless _mod_indent_first is TRUE.
					*/

					case "PROCEDURE":
					case "MODULE":
					case "IMPLEMENTATION":
					case "DEFINITION":
						if (_mod_indent_first)
							++code_line;

					/*
					**		VAR, CONST, and TYPE are no problem.
					*/

					case "VAR":
					case "CONST":
					case "TYPE":
					case "FROM":
					case "IMPORT":
					case "EXPORT":
						nothing ();

					/*
					**		Other declarations are probably indented
					**	a level from where we want to be.
					*/

					default:
						--code_line;
					}
				if (code_indent_level != code_line)
					.mod_reindent (code_text, code_indent_level = code_line);

				}
			/*
			**		Outdent an END so it's flush with the last keyword
			**	that could match it.  We put END in the search pattern
			**	so nested blocks work.	ELSE keywords should be indented
			**	one additional level if they matched a CASE.
			*/

			case "END;":
			case "END":
			case "ELSE":
			case "ELSIF":
				{
				match_indented = .mod_outdent_to_match 
					("<|[ \\t]{BEGIN}|{CASE}|{FOR}|{IF}|{LOOP}|{MODULE}|{RECORD}|{WHILE}|{WITH}|{END;@}[ \\t\\n (]", code_indent_level, code_text);
				}
			/*
			**		Outdent an UNTIL until it aligns with a logical REPEAT.
			*/

			case "UNTIL":
				{
				match_indented = .mod_outdent_to_match ("<|[ \\t]{REPEAT}|{UNTIL}[ \\t\\n (]", code_indent_level, code_text);
				code_trail = '\;';
				}
			/*
			**		Outdent modules to column 1.
			*/

			case "MODULE":
			case "IMPLEMENTATION":
			case "DEFINITION":
				if (code_indent_level)
					.mod_reindent (code_text, code_indent_level = 0);
			}

	/*
	**		Don't let the indenting level go negative.
	*/

	if (code_indent_level < 0)
		code_indent_level = 0;

	/*
	**		Check the parameter.  If it's TRUE, we put the line back
	**	together and return.
	*/

	if (get_parm (0, scratch) && scratch)
		{
		end_of_line ();

		if (following_string != "")
			insert (following_string);

		return;
		}
	/*
	**		Move to the next line, inserting a new line below the current
	**	one if in insert mode.
	*/

	if (inq_mode ())
		{
		end_of_line ();
		insert ("\n");
		}
	else
		down ();

	/*
	**		Now we calculate where to put the cursor on the next line.
	**	The actual algorithm for the default indenting style is:
	**
	**		If the code line was a BEGIN, we indent the next line if
	**	_mod_indent_block is TRUE.
	**
	**		If the code line was an END, we check match_indented; if
	**	it's TRUE, we outdent afterwards, but we normally leave
	**	the cursor under the END.
	**
	**		Declarations force an indent, as do procedure declarations
	**	when _mod_indent_first is TRUE.
	**
	**		All other cases use the default rule, which is to indent if
	**	the last token was a special keyword, and not to indent
	**	otherwise.
	*/


	switch (token)
		{
		case "BEGIN":
		case "RECORD":
			if (_mod_indent_block)
				++code_indent_level;

		case "END;":
		case "END":
			if (match_indented)
				--code_indent_level;

		case "VAR":
		case "CONST":
		case "TYPE":
		case "FROM":
		case "IMPORT":
		case "EXPORT":
			++code_indent_level;

		case "PROCEDURE":
		case "MODULE":
		case "IMPLEMENTATION":
		case "DEFINITION":
			if (_mod_indent_first)
				++code_indent_level;

		/*
		**		We indent when a line ended in THEN, ELSE, ELSIF, DO, OF,
		**	REPEAT, LOOP, or RECORD.  This works well except when a
		**	comment line ends in one of these keywords.	We also
		**	indent when a line ends in a colon (we're probably
		**	in a CASE) and outdent when one ends in a vertical bar
		**	(ditto).
		*/

		default:
			if (code_trail != '\;')

				if (code_trail == ':')
					++code_indent_level;
				else
					if (code_trail == '|')
						--code_indent_level;
					else
						{
						sprintf (code_text, "~%s~", substr (code_text, rindex (" " + code_text, " ")));

						if (index (TERMINAL_LIST, code_text))
							++code_indent_level;
						else if ("~UNTIL~" == code_text)
							--code_indent_level;
						}
		}
	/*
	**		Move to the new position.
	**
	**	If we cut characters from the previous line, reinsert them.
	*/

	move_abs (0, .mod_indent_level (code_indent_level));

	if (following_string != "")
		{
		save_position ();
		insert (following_string);
		restore_position ();
		}
}

/*
**		Maps between indent levels (in tab stops) and column positions in a
**	file.  Column 1 to just before the first tab stop is level 0; from
**	the first to just before the second tab stop is level 1; etc.
**
**		If a parameter is passed, we treat it as an indent level, and we
**	calculate the column corresponding to it.  Otherwise, we calculate
**	the indent level corresponding to the current column.
*/

int .mod_indent_level (~int)
{
	int	curr_col,
			level,
			lev_to_col;

	save_position ();
	curr_col = 1;

	if (get_parm (0, lev_to_col))
		{
		beginning_of_line ();

		while (level < lev_to_col)
			{
			move_abs (0, curr_col += distance_to_tab ());
			++level;
			}
		level = curr_col;
		}
	else
		{
		inq_position (NULL, lev_to_col);
		beginning_of_line ();

		while ((curr_col += distance_to_tab ()) <= lev_to_col)
			{
			move_abs (0, curr_col);
			++level;
			}
		}
	restore_position ();
	returns (level);
}

/*
**		Moves the cursor to the first character on the current line that
**	is not a space or a tab.
*/

void .mod_first_nonwhite ()
{
	beginning_of_line ();
	next_char (strlen (read ()) - strlen (ltrim (read ())));
}

/*
**		Outdents a line until it pairs up with another keyword.
**
**		If the match is of an ELSE to a CASE, the ELSE is reindented one
**	tab stop to the right of the CASE line.  If the match is of an END
**	(or an UNTIL) the END (in some styles) is reindented; the trailing
**	END of a procedure or module is exempted.
**
**	Parameters:
**		0 -- the search pattern.
**		1 -- the current indenting level.
**		2 -- the trimmed text of the line being outdented.
**
**	Returns:
**		TRUE if the line was an END or UNTIL indented an extra level.
**
**		Puts the new indenting level, if it changes, back into parameter 1.
*/

int .mod_outdent_to_match (string match_pattern, int curr_indent_level, string trim_text)
{
	int	new_indent_level,
			nesting,
			token_matched;

	save_position ();
	nesting = 1;

	/*
	**		Repeat until nesting is zero, or until we can't find another
	**	keyword.  END and UNTIL increase the nesting level; other
	**	keywords decrease it.
	*/

	while (nesting)
		{								 		
		move_abs (0, MAX_COL);

		if (!(up () && search_back (match_pattern, 1, 1))) 
			{
			restore_position ();
			return (FALSE);
			}
		if (token_matched = index (BLOCK_LIST, trim (substr (ltrim (read ()), 1, 3))))
			--nesting;
		else
			++nesting;
		}
	/*
	**		We have found the matching line.
	*/

	.mod_first_nonwhite ();
	new_indent_level = .mod_indent_level ();
	restore_position ();

	/*
	**		If the line being outdented began with an ELSE and we
	**	matched a CASE, we position the ELSE in an additional level.
	**	For an ELSIF, we do nothing.
	**
	**		If the line being outdented began with an END, and the
	**	current indenting style is to indent the end of a block
	**	(but not a procedure) then we position that in an
	**	additional level.
	**
	**		We reuse nesting here to hold a return value.
	*/

	nesting = FALSE;

	if (token_matched == CASE_POS)
		{
		if ("ELSE" == substr (trim_text, 1, 4))
			++new_indent_level;

		else if (_mod_indent_close)
			{
				++new_indent_level;
				nesting = TRUE;
			}
		}
	if (_mod_indent_close && token_matched > CASE_POS)
		{
		get_parm (2, trim_text);

		if (index ("END UNT", substr (trim_text, 1, 3)))
			{
			++new_indent_level;
			nesting = TRUE;
			}
		}
	if (new_indent_level != curr_indent_level)
		{
		.mod_reindent (trim_text, new_indent_level);
		put_parm (1, new_indent_level);
		}
	returns (nesting);
}

/*
**		.mod_abbrev:
**
**		This macro performs template expansion for Modula-2.	When it is
**	invoked, the characters before the cursor are checked to see if
**	they are the start of a Modula-2 keyword, preceded by a space or a
**	tab, and followed only by whitespace.	If a match is found, the
**	remainder of the statement is filled in automatically.
**
**		Expansion is only done when we're at or past the end of the
**	line, and when the line is less than 8 characters long.	This
**	makes expansion faster and avoids unwanted expansion.
*/

void .mod_abbrev ()
{
	int	done;

	/*
	**		Expand only when we're at the end of the line.
	*/

	if (read (1) == "\n")
		{
		int	loc;

		string	line;

		/*
		**		Get a trimmed representation of the line into a string.
		*/

		save_position ();
		beginning_of_line ();
		loc = strlen (line = (trim (ltrim (read ()))));

		/*
		**		Only do template expansion if the trimmed version
		**	of the line is at least _mod_min_abbrev characters long,
		**	at most 8 characters long, matches an expansion in
		**	one of the ABBR_LISTs, and is shorter than that token.
		**	We do all comparisons in upper case.
		**
		**		If the keyword is found in the second list, we use a
		**	negative value for done.
		*/


		if ((loc <= 8 && loc >= _mod_min_abbrev) && ((done = index (ABBR_LIST_1, "~" + line))
			|| (done = 0 - index (ABBR_LIST_2, "~" + line))))
			{
			string	completion;

			/*
			**		Extract the full, expanded keyword from the
			**	abbreviation list, and make sure it's longer
			**	than the abbreviation.
			*/

			completion = done > 0 ? substr (ABBR_LIST_1, ++done) : substr (ABBR_LIST_2, 1 - done);
			completion = substr (completion, 1, index (completion, "~") - 1);

			if (completion == "EI")
				completion = "ELSIF";

			if (loc < strlen (completion))
				{
				/*
				**		Delete the abbreviation from the buffer, and
				**	replace it with the expanded version.
				*/

				.mod_first_nonwhite ();
				delete_to_eol ();
				insert (completion);

				/*
				**		Insert necessary context for each keyword.
				*/

				switch (completion)
					{
					case "BEGIN":
						.mod_expand_block ("END", FALSE);

					case "IF":
						{
						save_position ();
						.mod_expand_block ("END;", _mod_indent_close);
						delete_line ();
						restore_position ();
						.mod_expand_pair ("THEN");
						}
					case "WHILE":
					case "FOR":
					case "WITH":
						{
						save_position ();
						.mod_expand_block ("END;", _mod_indent_close);
						delete_line ();
						restore_position ();
						.mod_expand_pair ("DO");
						}
					case "ELSE":
					case "VAR":
					case "CONST":
					case "TYPE":
						open_line ();

					case "REPEAT":
						.mod_expand_block ("UNTIL ", FALSE);

					case "LOOP":
						.mod_expand_block ("END;", _mod_indent_close);

					case "CASE":
						{
						save_position ();
						.mod_expand_block ("END;", _mod_indent_close);
						delete_line ();
						restore_position ();
						.mod_expand_pair ("OF");
						}
					case "ELSIF":
						{
						.mod_indent (1);
						.mod_expand_pair ("THEN");
						}
					case "DEFINITION":
					case "IMPLEMENTATION":
						insert (" MODULE ");

					case "FROM":
						{
						.mod_indent (1);
						.mod_expand_pair ("IMPORT ");
						}
					case "EXPORT":
						{
						.mod_indent (1);
						insert (" QUALIFIED ");
						}
					default:
						{
						.mod_indent (1);
						insert (" ");
						}
					}
				}

			else
				done = FALSE;
			}
		restore_position (!done);
		}

	/*
	**		If we couldn't expand an abbreviation, we perform the
	**	normal task associated with the key that called us: insert
	**	a space, or shift a marked block.
	*/

	if (!done)
		if (inq_local_keyboard () == _mod_alt_template)
			slide_in ();
		else
			self_insert ();
}

/*
**		Repositions a line at a specified indent level.
**
**	Parameters:
**		0 -- the text of the line to reindent.
**		1--the new indent level.
*/

void .mod_reindent (string text, int curr_indent_level)
{
	beginning_of_line ();
	delete_to_eol ();
	move_abs (0, .mod_indent_level (curr_indent_level));
	insert (text);
}

/*
**		Adds a matching keyword below the expanded template, at the same
**	indent level; then inserts a line between the pair and leaves the
**	cursor on it.	Since inserting a line may reindent the current
**	line, it does this in a strange order.
**
**		If the second parameter is TRUE, adds the matching keyword at the
**	next tab stop.
*/

void .mod_expand_block (string keyword, int indent_close)
{
	int	level,
			col;

	open_line ();
	save_position ();
	move_rel (-1, NEG_MAX_COL);
	.mod_first_nonwhite ();
	
	/* 
	** If matching keyword is indented to next tab stop, figure
	** out the current indentation level and increment it.  
	** Otherwise, just figure out the current column.
	*/

	if (indent_close)
		{
		level = .mod_indent_level ();
		++ level;
		}
	else
		inq_position (0, col);

	move_rel (1, NEG_MAX_COL);
	insert ("\n");

	if (indent_close)
		move_abs (0, .mod_indent_level (level));
	else
		move_abs (0, col);

	insert (keyword);
	restore_position ();
}

/*
**		Expands a keyword pair, positioning the cursor between the two
**	keywords.
*/

void .mod_expand_pair (string keyword)
{
	save_position ();
	insert ("  " + keyword);
	restore_position ();
	right ();
}