Files
TeslaRel410/sda4/BRIEF/MACROS/ADA.CB
T
CydandClaude Fable 5 db7745fcd0 sda4: commit the Glaze developer hard-drive dump
Un-ignored: the dev drive is the ground truth the restoration and
emulator work constantly reference (DPL3/LIBDPL + VRENDER i860 renderer
source, BT/RP live+dev game trees, VGL_LABS pod boot, scene/audio
content). Kept in-repo for the pod-owner community.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
2026-07-04 19:41:15 -05:00

885 lines
21 KiB
Plaintext

/*
** 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);
}