/*
**		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.
*/

/*
**
**		ada.cb:
**
**			Smart indenting and template editing for ADA.  This package
**		works for files with the extensions .ada.  Other languages
**		extensions can be supported by SETUP or manual extension
**		equivalence.
*/

#define FALSE			  0
#define TRUE			  1

#define MIN_ABBREV	  1

#define ADA_SKIP_PAT   "{{--*\n}|{\\<\\<[~<>\n]@\\>\\>}|[ \xc\t\n]}@"

/*
**  Note:  the "!" found after the two letter abbreviations (i.e. AG, DR,
**	 DG, etc) is an internal convention in order to ensure that the
**  abbreviation's length is less than the completion length.  Thus,
**  the user does NOT have to type in the "!" to ensure the two letter
**	 abbreviations' expansions.
*/
#define ABBR_LIST_1	  "~ACCEPT~ABORT~BEGIN~CASE~ELSE~ELSIF~EI!~ENTRY~EXCEPTION~EXIT~EXIT WHEN~EW!~FUNCTION~FOR~IF~LOOP~OR~PROCEDURE~"
#define ABBR_LIST_2	  "~PACKAGE~PACKAGE BODY~PB!~PACKAGE IS NEW~PN!~RETURN~RECORD~SUBTYPE~SELECT~TYPE~TASK~TASK BODY~TB!~TERMINATE~"
#define ABBR_LIST_3	  "~USE~WITH~WHEN~WHEN OTHERS~WO!~WHILE~"

#define KW_LIST		  "~ACCEPT~BEGIN~CASE~ELSE~ELSIF~FOR~FUNCTION~IF~LOOP~OR~PACKAGE~PROCEDURE~RECORD~SELECT~TASK~WHEN~WHILE~"

#define KW_LOWER		  0
#define KW_UPPER		  1
#define KW_MIXED		  2

#define MAX_COL		  20736
#define NEG_MAX_COL	  -20736

/*
**		Function Prototypes
*/

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

string	.ada_smart_first ();		  
string 	.ada_template_first (~int, ~int);
int		.ada_indent_level (~int);
void		.ada_indent (int);
void		.ada_abbrev ();
void		.ada_first_nonwhite ();
string	.ada_keyword_cvt (string);
void		.ada_reindent (string, int);
void		.ada_expand_block (string);
void		.ada_expand_pair (string);
void		.ada_expand_full (string, string);
int		.ada_next_word ();
int 		.ada_previous_word ();

/*
**		Allocate the global variables and set up the keymaps.
*/

int	_ada_smart,
		_ada_template,
		_ada_alt_template,
		_ada_keyword_case,
		_ada_min_abbrev;


/*
**		Turn on smart indenting for ADA.  This macro is designed to
**	be run the first time a file is edited, but may also be run from
**	the command line.
*/

string .ada_smart_first ()
{
   if (first_time())
   {
	   keyboard_push ();
	   assign_to_key ("<Enter>", ".ada_indent");
	   assign_to_key ("<Tab>", "slide_in");
	   assign_to_key ("<Shift-Tab>", "slide_out");
	   _ada_smart = inq_keyboard ();
	   keyboard_pop (1);
   }
	use_local_keyboard (_ada_smart);
	returns ("");
}

/*
**		Turn on template editing for ADA.  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 -- the minimum length of abbreviations that should be expanded.
**			If this is 0, abbreviations are only expanded when <Tab>
**			is pressed.  If it is 1, b<Space> will expand to a BEGIN/END
**			block; if it is 2, you would need to type be<Space> in order
**			to expand the template.
**		1 -- controls case of expanded keywords.	If this is 0, r<Space>
**			expands to "return"; if 1, it expands to "RETURN"; and if 2,
**			it expands to "Return".
**
**	Defaults:  1 0
*/

string .ada_template_first (~int, ~int)
{
	_ada_min_abbrev = MIN_ABBREV;
	_ada_keyword_case = KW_LOWER;

	get_parm (0, _ada_min_abbrev);
	get_parm (1, _ada_keyword_case);

   if (first_time())
   {
	   keyboard_push ();
	   assign_to_key ("<Enter>", ".ada_indent");
	   assign_to_key ("<Tab>", ".ada_abbrev");
	   assign_to_key ("<Shift-Tab>", "slide_out");
	   assign_to_key ("<Ctrl-s>", "just_space");
	   _ada_alt_template = inq_keyboard ();
	   keyboard_pop (1);
	   keyboard_push ();
	   assign_to_key ("<Enter>", ".ada_indent");
	   assign_to_key ("<Tab>", "slide_in");
	   assign_to_key ("<Shift-Tab>", "slide_out");
	   assign_to_key ("<Space>", ".ada_abbrev");
	   assign_to_key ("<Ctrl-s>", "just_space");
	   _ada_template = inq_keyboard ();
	   keyboard_pop (1);
   }
	if (_ada_min_abbrev == 0)
		{
   		use_local_keyboard (_ada_alt_template);
	   	_ada_min_abbrev = MIN_ABBREV;
		}
	else
		use_local_keyboard (_ada_template);

	returns ("");
}


/*
**	These definitions are used as Ada "language sensitive" word patterns
*/

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

int .ada_previous_word ()
{
	returns (.c_previous_word ());
}


/*
**		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 .ada_indent_level (~int)
{
	int	curr_col,
			lev_to_col,
			level;

	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);
}

/*
**		.ada_indent:
**
**		This macro does syntax-sensitive indenting ("smart indenting") for
**	ADA language files.
**
**	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 .ada_indent (int scratch)
{
	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.

	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.
				prev_token;				//	First token on 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 (ADA_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.
 		*/

 		.ada_first_nonwhite ();
 		code_indent_level = .ada_indent_level ();
 		code_text = trim (read ());

 		/*
 		**		Find the last code line before this, as well as its
 		**	last code character and whether or not it contains
 		**	ADA keywords that affect indenting.
 		*/

 		if (up ())
 			{
 			end_of_line ();

 			if (search_back (ADA_SKIP_PAT, -2) && prev_char ())
 				{
 				prev_trail = atoi (read (1), 0);
 				.ada_first_nonwhite ();
 				prev_indent_level = .ada_indent_level ();
				prev_text = trim (read ());

				/*
				**		Get the first token on the previous line.
				*/
				prev_token = upper (substr (prev_text, 1, index (prev_text + " ", " ") - 1));
				}
			}
		/*
		**		Get the first token on the code line.	This assumes
		**	that tokens are separated by spaces.
		*/

		token = upper (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)
		{
		code_line = prev_indent_level;

		switch (token)
			{
			/*
			**		If the last token on the previous line was IS, we align
			**	a BEGIN with that line.  If not, we outdent the BEGIN
			**	one level.
			*/

			case "BEGIN":
				if ("IS" != upper (substr (prev_text, rindex (" " + prev_text, " "))))
					--code_line;

			/*
			**		ELSE should be outdented one level from the
			**	previous line, unless the last line was a clause
			**	like "IF x THEN y;".
			*/

			case "ELSE":
			case "ELSIF":
				if (!((prev_token == "IF" || prev_token == "ELSIF") && prev_trail == ';'))
					--code_line;

			/*
			**		END should usually be outdented one level from the
			**	previous line.  Exceptions are at the end of a CASE
			**	statement, when we have to outdent two levels,
			**	and at the end of any block with no intervening
			**	indented text, when we want to stay put.	(We guess
			**	that a line beginning with any of certain keywords
			**	and ending with a semicolon is a block of the form
			**	"IF x THEN y;").
			*/

			case "END;":
			case "END":
				{
				if (!(index (KW_LIST, "~" + (prev_token + "~")) && prev_trail == ';'))
					if (index (upper (substr (code_text, 5)), "CASE") && prev_token != "WHEN")
						code_line -= 2;
					else
						--code_line;

				code_trail = '\;';
				}

			/*
			**		If the previous line began with CASE or EXCEPTION,
			**	we indent the code line one level from it.  If the
			**	previous line began with WHEN, we align the lines.
			**	Otherwise, we outdent the code line one level.
			*/

			case "WHEN":
				switch (prev_token)
					{
					case "CASE":
					case "EXCEPTION":
						++code_line;

					case "WHEN":
						nothing ();

					default:
						--code_line;
					}
			/*
			**		OR should always be outdented. Maybe EXCEPTION should as well.
			*/

			case "OR":
			case "EXCEPTION":
				--code_line;

			default:
				code_line = code_indent_level;
			}
		/*
		**		Reindent only when necessary.
		*/		

		if (code_indent_level != code_line)
			.ada_reindent (code_text, code_indent_level = code_line);
		}
	/*
	**		Check the parameter.  If it's TRUE, we put the line back
	**	together and return.
	*/

	if (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 ();

	if (code_indent_level < 0)
		code_indent_level = 0;

	/*
	**		We indent the cursor unless the code line ended in a semicolon.
	*/

	if (code_trail != '\;')
		++code_indent_level;

	/*
	**		Move to the new position.
	**
	**		If we cut characters from the previous line, reinsert them.
	*/

	move_abs (0, .ada_indent_level (code_indent_level));

	if (following_string != "")
		{
		save_position ();
		insert (following_string);
		restore_position ();
		}
}

/*
**	.ada_abbrev:
**
**		This macro performs template expansion for ADA.  When it is
**	invoked, the characters before the cursor are checked to see if
**	they are the start of a ADA 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 10 characters long.	This
**	makes expansion faster and avoids unwanted expansion.
*/

void .ada_abbrev ()
{
	int	done; 						// index into keywords lists
	
	/*
	**		Expand only when we're at the end of the line.
	*/

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

		string	line,
					which_abbrev;

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

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

		/*
		**		Only do template expansion if the trimmed version
		**	of the line is at least _ada_min_abbrev characters long,
		**	at most 10 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	(done = index (ABBR_LIST_1, "~" + line))
			which_abbrev = ABBR_LIST_1;
		else if (done = index (ABBR_LIST_2, "~" + line))
			which_abbrev = ABBR_LIST_2;
		else if (done = index (ABBR_LIST_3, "~" + line))
			which_abbrev = ABBR_LIST_3;

		if ((loc <= 10) && (loc >= _ada_min_abbrev) && loc && done)
			{
			string completion;

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

			completion = substr (which_abbrev, ++done);
			completion = substr (completion, 1, index (completion, "~") - 1);

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

				.ada_first_nonwhite ();
				delete_to_eol ();

				/*
				**		Insert necessary context for each keyword.
				*/

				switch (completion)
					{
					case "ABORT":
					case "EXIT":
					case "TERMINATE":
						{
						insert (.ada_keyword_cvt (completion));
						insert (";");
						}
					case "RETURN":
					case "USE":
					case "WITH":
						{
						insert (.ada_keyword_cvt (completion));
						insert (" ;");
						}
					case "ACCEPT":
						{
						insert (.ada_keyword_cvt (completion));
						.ada_expand_full ("END ;", "DO");
						}
					case "BEGIN":
					case "EXCEPTION":
						{
						insert (.ada_keyword_cvt (completion));
						open_line ();
						}
					case "CASE":
						{
						insert (.ada_keyword_cvt (completion));
						.ada_expand_full ("END CASE;", "IS");
						}
					case "ELSE":
					case "OR":
						{
						insert (.ada_keyword_cvt (completion));
						.ada_indent (1);
						open_line ();
						}
					/*
					** Note: the "!" is an internal convention to ensure
					** that the abbreviation length is less than the
					** completion length.
					*/
					case "WHEN OTHERS":
					case "WO!":
						{
						insert (.ada_keyword_cvt ("WHEN OTHERS =>"));
						.ada_indent (1);
						open_line ();
						}
					/*
					** Note: the "!" is an internal convention to ensure
					** that the abbreviation length is less than the
					** completion length.
					*/
					case "EI!":
					case "ELSIF":
						{
						insert (.ada_keyword_cvt ("ELSIF"));
						.ada_indent (1);
						.ada_expand_pair ("THEN");
						}
					case "FOR":
					case "WHILE":
						{
						insert (.ada_keyword_cvt (completion));
						.ada_expand_full ("END LOOP;", "LOOP");
						}
					case "FUNCTION":
					case "PROCEDURE":
						{
						insert (.ada_keyword_cvt (completion));
						save_position ();
						.ada_expand_block ("END ;");
						back_tab ();
						insert (.ada_keyword_cvt ("BEGIN"));
						restore_position ();
						.ada_expand_pair ("IS");
						}
					/*
					** Note: the "!" is an internal convention to ensure
					** that the abbreviation length is less than the
					** completion length.
					*/
					case "TASK BODY":
					case "TB!":
						{
						insert (.ada_keyword_cvt ("TASK BODY"));
						save_position ();
						.ada_expand_block ("END ;");
						back_tab ();
						insert (.ada_keyword_cvt ("BEGIN"));
						restore_position ();
						.ada_expand_pair ("IS");
						}

					case "IF":
						{
						insert (.ada_keyword_cvt (completion));
						.ada_expand_full ("END IF;", "THEN");
						}
					case "LOOP":
						{
						insert (.ada_keyword_cvt (completion));
						.ada_expand_block ("END LOOP;");
						}
					case "PACKAGE":
					case "TASK":
						{
						insert (.ada_keyword_cvt (completion));
						.ada_expand_full ("END ;", "IS");
						}
					/*
					** Note: the "!" is an internal convention to ensure
					** that the abbreviation length is less than the
					** completion length.
					*/
					case "PACKAGE BODY":
					case "PB!":
						{
						insert (.ada_keyword_cvt ("PACKAGE BODY"));
						.ada_expand_full ("END ;", "IS");
						}
					/*
					** Note: the "!" is an internal convention to ensure
					** that the abbreviation length is less than the
					** completion length.
					*/
					case "PACKAGE IS NEW":
					case "PN!":
						{
						insert (.ada_keyword_cvt ("PACKAGE  IS NEW ;"));
						prev_char (9);
						}
					case "RECORD":
						{
						insert (.ada_keyword_cvt (completion));
						.ada_expand_block ("END RECORD;");
						}
					case "SELECT":
						{
						insert (.ada_keyword_cvt (completion));
						.ada_expand_block ("END SELECT;");
						}
					case "SUBTYPE":
					case "TYPE":
						{
						insert (.ada_keyword_cvt (completion));
						.ada_expand_pair ("IS");
						}
					case "WHEN":
						{
						insert (.ada_keyword_cvt (completion));
						.ada_indent (1);
						.ada_expand_pair ("=>");
						}
					/*
					** Note: the "!" is an internal convention to ensure
					** that the abbreviation length is less than the
					** completion length.
					*/
					case "EW!":
						{
						insert (.ada_keyword_cvt ("EXIT WHEN"));
						insert (" ");
						}
					default:
						{
						insert (.ada_keyword_cvt (completion));
						insert (" ");
						}
					}
				done = strlen (completion);
				}
			else
				done = FALSE;
			}
		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 () == _ada_alt_template)
			slide_in ();
		else
			self_insert ();
}


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

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

/*
**		Converts keywords into the user-specified preferred case.  If the
**	case is MIXED, the first separate letter of each "word" in the
**	keyword string is converted to upper case, and the others are
**	converted to lower case.
*/

string .ada_keyword_cvt (string keyword)
{
	switch (_ada_keyword_case)
		{
		case KW_UPPER:
			returns (upper (keyword));

		case KW_LOWER:
			returns (lower (keyword));

		case KW_MIXED:
			{
			int	space;

			string	retval;

			keyword = lower (keyword);

			while (space = index (keyword, " "))
				{
				retval += upper (substr (keyword, 1, 1));
				retval += substr (keyword, 2, space - 1);
				keyword = substr (keyword, ++space);
				}
			retval += upper (substr (keyword, 1, 1));
			returns (retval += substr (keyword, 2));
			}
		}
}

/*
**		Repositions a line at a specified indent level.
**
**	Parameters:
**		0 -- the text of the line to reindent.
**		1 -- the new indent level.
*/

void .ada_reindent (string text, int curr_indent_level)
{
	beginning_of_line ();
	delete_to_eol ();
	move_abs (0, .ada_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.
*/

void .ada_expand_block (string keyword)
{
	int	column;

	open_line ();
	save_position ();
	move_rel (-1, NEG_MAX_COL);
	.ada_first_nonwhite ();
	inq_position (NULL, column);
	move_rel (1, NEG_MAX_COL);
	insert ("\n");
	move_abs (0, column);
	insert (.ada_keyword_cvt (keyword));
	restore_position ();
}

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

void .ada_expand_pair (string keyword)
{
	save_position ();
	insert ("  " + .ada_keyword_cvt (keyword));
	restore_position ();
	right ();
}

/*
**		Expands a keyword block with a paired keyword on the first line.
*/

void .ada_expand_full (string keyword1, string keyword2)
{
	save_position ();
	.ada_expand_block (keyword1);
	delete_line ();
	restore_position ();
	.ada_expand_pair (keyword2);
}