TeslaRel410/sda4/BRIEF/MACROS/BASIC.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.
*/

/*
**
**		basic.cb:
**
**		Smart indenting and template editing for BASIC.
**
*/

#define FALSE			  0
#define TRUE			  1

#define MIN_ABBREV	  1

/*
**		This pattern treats REM statements as code for efficiency, since they
**	tend to be at the same indenting level as the surrounding code.
**	However, comments beginning with a single quote are skipped over
**	in figuring the indenting level, as are line identifiers.
*/

#define BAS_SKIP_PAT   "{{<[ \xc\t]@{[A-Z0-9!#$%]+[ \t]@:}|{[0-9]+}}|{'[~\"\n]@}|[ \xc\t\n]}@"

#define ABBR_LIST 	  "~CASE~DEF FN~ELSE~EI~ELSEIF~EXIT~FOR~FUNCTION~IF~ON~ON ERROR GOTO~RETURN~SELECT CASE~SUB~WHILE~"

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

#define MAX_COL		  20736
#define NEG_MAX_COL	  -20736

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

/*
**		Function Prototypes
*/

string	.bas_smart_first (~int, ~int, ~int);
string	.bas_template_first (~int, ~int, ~int, ~int);
int		.bas_indent_level (~int);
void		.bas_first_nonwhite ();
int 		.bas_outdent_to_match (string, int, string);
void 		.bas_indent (~int);
void 		.bas_abbrev ();
void 		.bas_reindent (int);
void 		.bas_expand_block (string, int);
void 		.bas_expand_pair (string);
void 		.bas_expand_full (string, string);
string 	.bas_keyword_cvt (string);
int		.bas_next_word ();
int 		.bas_previous_word ();

/*
**		Allocate the global variables and set up the keymaps.
*/

int	_bas_smart,
		_bas_template,
		_bas_alt_template,
		_bas_keyword_case,
		_bas_indent_block,
		_bas_indent_close,
		_bas_indent_first,
		_bas_min_abbrev;


/*
**		Turn on smart indenting for BASIC.	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.  
**		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 .bas_smart_first (~int, ~int, ~int)
{
   if (first_time())
   {
	   keyboard_push ();
	   assign_to_key ("<Enter>", ".bas_indent");
	   assign_to_key ("<Tab>", "slide_in");
	   assign_to_key ("<Shift-Tab>", "slide_out");
	   _bas_smart = inq_keyboard ();
	   keyboard_pop (1);
   }
	use_local_keyboard (_bas_smart);
	_bas_indent_block = TRUE;
	_bas_indent_close = FALSE;
	_bas_indent_first = FALSE;

	get_parm (0, _bas_indent_block);
	get_parm (1, _bas_indent_close);
	get_parm (2, _bas_indent_first);
	returns ("");
}

/*
**		Turn on template editing for BASIC.  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>.
**		4 -- controls case of expanded keywords.	If this is 0, w<Space>
**			expands to "while"; if 1, it expands to "WHILE"; and if 2,
**			it expands to "While".
***
**	Defaults:  1 0 0 1 1
*/

string .bas_template_first (~int, ~int, ~int, ~int)
{
	_bas_indent_block = TRUE;
	_bas_indent_close = FALSE;
	_bas_indent_first = FALSE;
	_bas_min_abbrev = MIN_ABBREV;
	_bas_keyword_case = KW_UPPER;

	get_parm (0, _bas_indent_block);
	get_parm (1, _bas_indent_close);
	get_parm (2, _bas_indent_first);
	get_parm (3, _bas_min_abbrev);
	get_parm (4, _bas_keyword_case);

   if (first_time())
   {
	   keyboard_push ();
	   assign_to_key ("<Enter>", ".bas_indent");
	   assign_to_key ("<Tab>", ".bas_abbrev");
	   assign_to_key ("<Shift-Tab>", "slide_out");
	   assign_to_key ("<Ctrl-s>", "just_space");
	   _bas_alt_template = inq_keyboard ();
	   keyboard_pop (1);
	   keyboard_push ();
	   assign_to_key ("<Enter>", ".bas_indent");
	   assign_to_key ("<Tab>", "slide_in");
	   assign_to_key ("<Shift-Tab>", "slide_out");
	   assign_to_key ("<Space>", ".bas_abbrev");
	   assign_to_key ("<Ctrl-s>", "just_space");
	   _bas_template = inq_keyboard ();
	   keyboard_pop (1);
   }
	if (_bas_min_abbrev == 0)
		{
		use_local_keyboard (_bas_alt_template);
		_bas_min_abbrev = MIN_ABBREV;
		}
	else
		use_local_keyboard (_bas_template);

	returns ("");
}

/*
**	These definitions are used as Basic "language sensitive" word patterns
*/
int .bas_next_word ()
{
	returns (.c_next_word ());
}

int .bas_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 .bas_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, or a line number.
*/

void .bas_first_nonwhite ()
{
	string line;

	beginning_of_line ();

	/*
	**		If the line begins with a number, it may be a line number.
	**	In that case, we do a complicated (and relatively slow)
	**	search to get us to the first character after the line number.
	**	Then we skip over whitespace to get to the real line beginning.
	**
	**		Since there is no quick way to detect an alphanumeric line
	**	label, we assume they only appear by themselves on lines.
	**	We can't look for a colon to find potentially labeled lines,
	**	because colons are too common, and searching would be too
	**	inefficient in this context.
	*/

	if (atoi (line = read ()))
		{
		int length;

		if (search_string ("<[ \xc\t]@[0-9]+", line, length, -1, 1))
			{
			next_char (length);
			line = read ();
			}
		}
	next_char (strlen (line) - strlen (ltrim (line)));
}

/*
**	Outdents a line until it pairs up with another keyword.
**
**	Parameters:
**		0 -- the search pattern.
**		1 -- the current indenting level.
**		2 -- if passed, a keyword that increments the nesting level
**			when we find it.	If not passed, it defaults to END.
**
**	Puts the new indenting level, if it changes, back into parameter 1.
*/

int .bas_outdent_to_match (string match_pattern, int curr_indent_level, ~string)
{
	int nesting;
	string end_keyword;

	save_position ();

	end_keyword = get_parm (2, end_keyword) ? upper (substr (end_keyword, 1, 3)) : "END";
	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, 0)))
			{
			restore_position ();
			return (FALSE);
			}
		if (upper (substr (ltrim (read ()), 1, 3)) == end_keyword)
			++nesting;
		else
			--nesting;
		}

	/*
	**		We have found the matching line.
	*/

	.bas_first_nonwhite ();
	nesting = .bas_indent_level ();
	restore_position ();

	if (nesting != curr_indent_level)
		{
		.bas_reindent (nesting);
		put_parm (1, nesting);
		}
}

/*
**		.bas_indent:
**
**		This macro does syntax-sensitive indenting ("smart indenting") for
**	BASIC language files.  It handles most common constructs, except
**	for nested comments.
**
**	Parameters:
**		0 -- If FALSE, forces split mode (see below).  If TRUE, forces
**			non-split mode.  If the parameter is omitted, split mode
**			depends on whether or not BRIEF is in insert mode.
*/

void .bas_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.
		 split_mode,				// Should we insert a newline?
		 scratch;					// Temporary integer.

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

	/*
	**		.bas_indent has two modes.
	**
	**		Both modes will reindent the current line if necessary and
	**	position the cursor correctly on the following line.
	**
	**		When BRIEF is in insert mode, or this macro is called from
	**	open_line, .bas_indent will add a new line to the buffer.  The
	**	contents depend on the cursor position when .bas_indent is
	**	called:	if the cursor is at the end of the line, the new line
	**	will be blank, but if not, the old line will be split in two.
	**
	**		When BRIEF is in overstrike mode and the macro was not called
	**	by open_line, BRIEF does not add a new line.  Note that open_line
	**	doesn't call the macro directly, but calls it via key assignment,
	**	which makes life difficult for us.
	**
	**		You can pass an integer parameter to .bas_indent to force
	**	it into either mode.  If the parameter is FALSE, .bas_indent
	**	will split; if it's TRUE, it won't.
	*/

	split_mode = inq_mode () || inq_command () == "open_line";

	if (get_parm (0, scratch))
		split_mode = !scratch;

	/*
	**		If we're splitting, and not at the end of the line, we save
	**	the end of the line (minus its newline) and delete it.
	*/

	if (split_mode && read (1) != "\n")
		{
		following_string = read ();
		following_string = substr (following_string, 1, strlen (following_string) - 1);
		delete_to_eol ();
		}
	else
		end_of_line ();

	/*
	**		Find the last "code" character; skip back over whitespace, labels
	**	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.
	*/

	search_back (BAS_SKIP_PAT, -2, 0);

	/*
	**		Remember which line we found the code character on, the code
	**	portion of the line, and the indent level.
	*/

	if (prev_char ())
		{
		inq_position (code_line);

		/*
		**		Find the first non-white character on the line, so
		**	we may determine its indenting level.	Skip over any
		**	leading line identifier.
		*/

		.bas_first_nonwhite ();
		code_indent_level = .bas_indent_level ();
		code_text = upper (trim (read ()));

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

		beginning_of_line ();

		if (prev_char ())
			{
			search_back (BAS_SKIP_PAT, -2, 0);

			if (prev_char ())
				{
				.bas_first_nonwhite ();
				prev_indent_level = .bas_indent_level ();
				prev_text = upper (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)

		switch (token)
			{
			/*
			**		Outdent an END so it's flush with its matching keyword.
			**	For END DEF and END SUB, we search for the last matching
			**	keyword; for END IF, we search for other IF statements
			**	as well as END IF (since nesting is permitted).  We take
			**	care not to match on the single-line forms of IF and
			**	DEF FN.
			*/
			case "END":
				{
				switch (substr (ltrim (substr (code_text, 4)), 1, 2))
					{
					case "DE":
						.bas_outdent_to_match ("<[ \t]@DEF FN[A-Z][~=]@>", code_indent_level);

					case "IF":
						.bas_outdent_to_match ("<[ \t]@{IF[ \t (]*THEN{[ \t]|{'*}}@>}|{END IF}", code_indent_level);

						/*
						**		Currently, if you have a line identifier
						**	on the same line as one of these keywords,
						**	the matcher won't work correctly.
						*/

					case "SU":
						.bas_outdent_to_match ("<[ \t]@SUB[ \t\n (']", code_indent_level);
					}
				}

			case "ELSE":
			case "ELSEIF":
				.bas_outdent_to_match ("<[ \t]@{IF[ \t (]*THEN{[ \t]|{'*}}@>}|{END IF}", code_indent_level);

			case "NEXT":
				.bas_outdent_to_match ("<[ \t]@{FOR}|{NEXT}[ \t\n (']", code_indent_level, "NEXT");

			case "WEND":
				.bas_outdent_to_match ("<[ \t]@{WHILE}|{WEND}[ \t\n (']", code_indent_level, "WEND");


			/*
			**		Outdent function and subroutine definitions to column 1.
			*/

			case "FUNCTION":
			case "SUB":
				if (code_indent_level)
					.bas_reindent (code_indent_level = 0);

			case "DEF":
				if (substr (code_text, 5, 2) == "FN" && code_indent_level)
					.bas_reindent (code_indent_level = 0);
			}

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

	if (code_indent_level < 0)
		code_indent_level = 0;

	/*
	**		Move to the next line, splitting if necessary.
	*/

	if (split_mode)
		{
		end_of_line ();
		insert ("\n");
		}
	else
		move_rel (1, NEG_MAX_COL);

	/*
	**		Now we calculate where to put the cursor on the next line.
	**	The actual algorithm for the default indenting style is:
	**
	**		Indent after a line that began with DEF FN, FOR, WHILE, SUB
	**	(but not for a one-line DEF FN).  Indent after a line that ended
	**	with THEN or ELSE
	**
	**		Otherwise leave the line alone.  Note: if we allow choices
	**	of indenting style, may have to work differently, even outdent
	**	cursor in some circumstances.  May want to indent if line
	**	ended in _.
	*/

	switch (token)
		{
		case "DEF":
			if (substr (code_text, 5, 2) == "FN" && !index (code_text, "="))
				++code_indent_level;

		case "FOR":
		case "SUB":
		case "WHILE":
		case "FUNCTION":
		case "SELECT":
			++code_indent_level;

		default:
			{
			token = substr (code_text, rindex (" " + code_text, " "));

			if (token == "ELSE" || token == "THEN")
				++code_indent_level;
			}
		}

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

	move_abs (0, .bas_indent_level (code_indent_level));

	if (following_string != "")
		{
		save_position ();
		insert (ltrim (following_string));
		restore_position ();
		}
}

/*
**	.bas_abbrev:
**
**		This macro performs template expansion for BASIC.	When it is
**	invoked, the characters before the cursor are checked to see if
**	they are the start of a BASIC 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 .bas_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 = upper ((trim (ltrim (read ())))));

		/*
		**		Only do template expansion if the trimmed version
		**	of the line is at least _bas_min_abbrev characters long,
		**	at most 8 characters long, matches an expansion in
		**	ABBR_LIST, and is shorter than that token.
		*/

		if ((loc <= 8 && loc >= _bas_min_abbrev) && (done = index (ABBR_LIST, "~" + line)))
			{
			string completion;
		
			/*
			**		Extract the full, expanded keyword from the
			**	abbreviation list, and make sure it's longer
			**	than the abbreviation.
			*/

			completion = substr (ABBR_LIST, ++done);
			completion = substr (completion, 1, index (completion, "~") - 1);

	
			switch (completion)
				{
				case "DF":
					completion = "DEF FN";
				case "EI":
					completion = "ELSEIF";
				}

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

				.bas_first_nonwhite ();
				delete_to_eol ();
				insert (.bas_keyword_cvt (completion));

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


				switch (completion)
					{
					case "DEF FN":
						.bas_expand_block ("END DEF", TRUE);

					case "FUNCTION":
						.bas_expand_block ("END FUNCTION", TRUE);

					case "ELSE":
						open_line ();

					case "ELSEIF":
						{
						.bas_indent (TRUE);
						move_rel (-1, NEG_MAX_COL);
						end_of_line ();
						.bas_expand_pair ("THEN");
						}

					case "FOR":
						.bas_expand_full ("NEXT", "= ");

					case "IF":
						.bas_expand_full ("END IF", "THEN");

					case "ON":
						.bas_expand_pair ("GOSUB ");

					case "SUB":
						.bas_expand_block ("END SUB", TRUE);

					case "WHILE":
						.bas_expand_block ("WEND", TRUE);

					case "SELECT CASE":
						.bas_expand_block ("END SELECT", TRUE);

					/*
					** Don't want to insert a space after RETURN.
					** Thus, make a special case for return to
					** prevent it from going into default.
					*/
					case "RETURN":
						nothing ();

					default:
						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 () == _bas_alt_template)
			slide_in ();
		else
			self_insert ();
}

/*
**		Converts keywords into the user-specified preferred case.
*/

string .bas_keyword_cvt (string keyword)
{
	int space;
	string ret_string,
			 current_word;

	switch (_bas_keyword_case)
		{
		case (KW_UPPER):
			returns (upper (keyword));

		case (KW_LOWER):
			returns (lower (keyword));

		case (KW_MIXED):
			{
			while (space = index (keyword, " "))
				{
				current_word = substr (keyword, 1, space);
				ret_string = ret_string + upper (substr (current_word, 1, 1)) + 
					lower (substr (current_word, 2));
				keyword = substr (keyword, space + 1);
				}
			ret_string = ret_string + upper (substr (keyword, 1, 1)) +
				lower (substr (keyword, 2));

			returns (ret_string);
			}
	  }
}

/*
**		Repositions a line at a specified indent level.
**
**	Parameters:
**		0 -- the new indent level.
*/

void .bas_reindent (int curr_indent_level)
{

	string temp;

	save_position ();
	.bas_first_nonwhite ();

	if (.bas_indent_level () != curr_indent_level)
		{
		temp = trim (read ());
		beginning_of_line ();
		delete_to_eol ();
		move_abs (0, .bas_indent_level (curr_indent_level));
		insert (temp);
		}
	restore_position ();
}

/*
**		Adds a matching keyword below the expanded template, at the same
**	column.
*/

void .bas_expand_block (string keyword, int insert_space)
{
	end_of_line ();
	.bas_indent (FALSE);
	move_rel (-1, NEG_MAX_COL);
	.bas_first_nonwhite ();
	down ();
	insert (.bas_keyword_cvt (keyword));
	move_rel (-1, NEG_MAX_COL);
	end_of_line ();
	if (insert_space)
		insert (" ");
}

/*
**		Expands a keyword pair, positioning the cursor between the two
**	keywords.
*/

void .bas_expand_pair (string keyword)
{

	save_position ();
	insert ("  " + (.bas_keyword_cvt (keyword)));
	restore_position ();
	right ();
}

void .bas_expand_full (string keyword1, string keyword2)
{
	.bas_expand_block (keyword1, FALSE);
	.bas_expand_pair (keyword2);
}