CydandClaude Fable 5
db7745fcd0
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>
1737 lines
45 KiB
Plaintext
1737 lines
45 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.
|
|
*/
|
|
|
|
/*
|
|
**
|
|
** cobol.cb:
|
|
**
|
|
** Smart indenting and template editing for COBOL. The smart
|
|
** indenter understands (within reasonable limits) code that
|
|
** conforms to both the 1985 and 1974 ANSI standards. The template
|
|
** system fully supports structured constructs from COBOL 85, and
|
|
** their use is encouraged. Line continuation is not currently
|
|
** supported.
|
|
**
|
|
** Keywords may be in upper, lower, or mixed case, as in COBOL 85.
|
|
**
|
|
** This package assumes that there are no literal tab characters
|
|
** in your COBOL source files. Since COBOL compilers are sensitive
|
|
** to the column position of certain characters and keywords, and
|
|
** tabs may take up varying numbers of columns, you must convert
|
|
** existing tab characters in your code to the proper number of
|
|
** spaces, before the indenting will work correctly.
|
|
**
|
|
** You may continue to use tab characters for non-COBOL files.
|
|
** The package will switch tabs on and off, as needed, when you
|
|
** switch from one file to another.
|
|
**
|
|
*/
|
|
|
|
#define FALSE 0
|
|
#define TRUE 1
|
|
|
|
/*
|
|
** The following defines are utilized for COBOL with sequence numbers
|
|
*/
|
|
|
|
#define COB_SKIP_PAT74 "<??????[~\\-+\n] @\\c[~ ]"
|
|
#define COB_MATCH_PAT74 "<??????[~\\-+\n] @\\c{END-}@%s[ .\n]"
|
|
#define COB_CMT_PAT74 "<??????\\*[*=\\->]@ @\\c[~ *\n]"
|
|
#define COB_CMT_COL74 7 // Comment char is in col 7.
|
|
#define COB_TEXT_COL74 8 // Text starts in col 8.
|
|
#define COB_CMT_CONT_COL74 10 // Continue comments at col 10.
|
|
#define COB_PIC_COL74 48 // Line up PIC clauses at col 48.
|
|
|
|
/*
|
|
** The following defines are utilized for COBOL without sequence numbers
|
|
*/
|
|
|
|
#define COB_SKIP_PAT85 "<[~\\-+*/\n] @\\c[~ ]"
|
|
#define COB_MATCH_PAT85 "<[~\\-+*/\n] @\\c{END-}@%s[ .\n]"
|
|
#define COB_CMT_PAT85 "<\\*[*=\\->]@ @\\c[~ *\n]"
|
|
#define COB_CMT_COL85 1
|
|
#define COB_TEXT_COL85 2
|
|
#define COB_CMT_CONT_COL85 4
|
|
#define COB_PIC_COL85 42
|
|
|
|
|
|
/*
|
|
** These defines are used by both ANSI '74 and ANSI '85.
|
|
*/
|
|
|
|
#define COB_RIGHT_MARGIN 73
|
|
#define COB_CMT_MARGIN 81
|
|
#define COB_DIVISION 8 // Column in which divisions should be placed
|
|
#define COB_CMT_CHAR "*" // Comment character is *.
|
|
#define COB_EJECT_CHAR "/" // Page break character.
|
|
|
|
/*
|
|
** 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 "~ADD~AG!~AE!~CALL~CLOSE~COMPUTE~DISPLAY~DATA~DELETE~DIVIDE~DG!~DR!~DF!~ELSE~ENVIRONMENT~EVALUATE~EXIT~EC!"
|
|
#define ABBR_LIST_2 "~GIVING~IF~IDENTIFICATION~MOVE~MULTIPLY~MG!~OPEN~PERFORM~PROCEDURE~READ~REWRITE~RETURN~SET~SEARCH~SELECT~"
|
|
#define ABBR_LIST_3 "~STRING~SUBTRACT~SG!~THRU~UNTIL~UNSTRING~VARYING~WHEN~WRITE~"
|
|
|
|
/*
|
|
** Certain keywords are not capitalized when in mixed case sensitivities.
|
|
*/
|
|
|
|
#define NO_CAPS "~BY~DELIMITED~FROM~GIVING~INTO~REMAINDER~TO~USING~"
|
|
|
|
#define ADD_CHAR_MACRO 0
|
|
#define MIN_ABBREV 1
|
|
#define MAX_COL 20736
|
|
#define NEG_MAX_COL -20736
|
|
|
|
#define CODE_ALIGN 0 // Where to indent comments.
|
|
#define CMT_ALIGN 1
|
|
#define COL_ALIGN 2
|
|
|
|
#define NO_SEQ_NUM 0 // Sequence numbers?
|
|
#define SEQ_NUM 1
|
|
|
|
#define KW_LOWER 0
|
|
#define KW_UPPER 1
|
|
#define KW_MIXED 2
|
|
|
|
/*
|
|
** Function Prototypes
|
|
*/
|
|
|
|
extern void slide_in ();
|
|
extern void open_line ();
|
|
extern int .c_previous_word ();
|
|
extern int .c_next_word ();
|
|
|
|
string .cob_smart_first (~int, ~int);
|
|
string .cob_smart_on ();
|
|
string .cob_template_first (~int, ~int, ~int, ~int);
|
|
string .cob_template_on ();
|
|
void .cob_smart_off ();
|
|
int .cob_indent (~int);
|
|
int .cob_outdent_to_match (string, int);
|
|
int .cob_last_stmt_level (int);
|
|
int .cob_is_level_number (string);
|
|
void .cob_first_nonwhite ();
|
|
int .cob_indent_level (~int);
|
|
void .cob_reindent (int);
|
|
int .cob_is_comment ();
|
|
void .cob_comment ();
|
|
void .cob_stmt_wrap ();
|
|
int .cob_split_stmt (int);
|
|
void .cob_abbrev ();
|
|
void .cob_expand_pair (string, string);
|
|
void .cob_reposition_keyword ();
|
|
void .cob_expand_block (string);
|
|
string .cob_keyword_cvt (string);
|
|
int .cob_next_word ();
|
|
int .cob_previous_word ();
|
|
void .cob_align ();
|
|
|
|
/*
|
|
** Allocate the global variables and set up the keymaps.
|
|
*/
|
|
|
|
int _cob_smart,
|
|
_cob_template,
|
|
_cob_alt_template,
|
|
_cob_min_abbrev,
|
|
_cob_comment_align,
|
|
_cob_old_fill,
|
|
_cob_ansi_85,
|
|
_cob_seq_num,
|
|
_cob_keyword_case;
|
|
|
|
|
|
/*
|
|
** Turn on smart indenting for COBOL. 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 -- Controls whether or not columns 1-6 should be used for
|
|
** sequence numbers.
|
|
**
|
|
** 1 -- Controls where the cursor is left when we are continuing
|
|
** an existing comment. Value of 0 means to leave the cursor at the
|
|
** current indent level (flush with the last line of code). 1
|
|
** means to leave it flush with the indent level of the last comment.
|
|
** 2 means to leave it at COB_CMT_CONT_COL??. Warning: a value of 1
|
|
** here will make indenting for comments slightly slower.
|
|
**
|
|
** 2 -- Whether or not the ANSI '85 standard is supported. If this
|
|
** is 0, ANSI '74 is assumed.
|
|
**
|
|
** Defaults: 0 0 1
|
|
*/
|
|
|
|
string .cob_smart_first (~int, ~int)
|
|
{
|
|
_cob_seq_num = NO_SEQ_NUM;
|
|
_cob_comment_align = CODE_ALIGN;
|
|
_cob_ansi_85 = TRUE;
|
|
get_parm (0, _cob_seq_num);
|
|
get_parm (1, _cob_comment_align);
|
|
get_parm (2, _cob_ansi_85);
|
|
|
|
if (first_time())
|
|
{
|
|
keyboard_push ();
|
|
assign_to_key ("<Enter>", ".cob_indent");
|
|
assign_to_key ("<Tab>", "slide_in");
|
|
assign_to_key ("<Shift-Tab>", "slide_out");
|
|
_cob_smart = inq_keyboard ();
|
|
keyboard_pop (1);
|
|
}
|
|
use_local_keyboard (_cob_smart);
|
|
returns ("");
|
|
}
|
|
|
|
/*
|
|
** Turn on smart indenting for COBOL. This macro is designed to
|
|
** be run every time a COBOL file is edited. It turns on statement
|
|
** wrap for COBOL, and forces empty areas to be filled with spaces.
|
|
*/
|
|
|
|
string .cob_smart_on ()
|
|
{
|
|
register_macro (ADD_CHAR_MACRO, ".cob_stmt_wrap");
|
|
_cob_old_fill = "y" == use_tab_char ("n");
|
|
returns (".cob_smart_off");
|
|
}
|
|
|
|
/*
|
|
** Turn on template editing for COBOL. 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, 1, 2 -- Same as .cob_smart_first.
|
|
**
|
|
** 3 -- The minimum prefix length required for template
|
|
** expansion. Set this parameter to 0 if you want to selectively
|
|
** expand templates by pressing <Tab>.
|
|
**
|
|
** 4 -- The preferred case for verbs that are expanded. Set
|
|
** this to 0 for lower case, 1 for upper case, and 2 for mixed
|
|
** case (initial caps). This option is ignored if you are not
|
|
** using COBOL 85.
|
|
**
|
|
** Defaults: 0 0 1 1 1
|
|
*/
|
|
|
|
string .cob_template_first (~int, ~int, ~int, ~int)
|
|
{
|
|
_cob_seq_num = NO_SEQ_NUM;
|
|
_cob_comment_align = CODE_ALIGN;
|
|
_cob_ansi_85 = TRUE;
|
|
_cob_min_abbrev = MIN_ABBREV;
|
|
_cob_keyword_case = KW_UPPER;
|
|
|
|
get_parm (0, _cob_seq_num);
|
|
get_parm (1, _cob_comment_align);
|
|
get_parm (2, _cob_ansi_85);
|
|
get_parm (3, _cob_min_abbrev);
|
|
|
|
if (_cob_ansi_85)
|
|
get_parm (4, _cob_keyword_case);
|
|
|
|
if (first_time())
|
|
{
|
|
keyboard_push ();
|
|
assign_to_key ("<Enter>", ".cob_indent");
|
|
assign_to_key ("<Tab>", ".cob_abbrev");
|
|
assign_to_key ("<Shift-Tab>", "slide_out");
|
|
assign_to_key ("<Ctrl-s>", "just_space");
|
|
_cob_alt_template = inq_keyboard ();
|
|
keyboard_pop (1);
|
|
keyboard_push ();
|
|
assign_to_key ("<Enter>", ".cob_indent");
|
|
assign_to_key ("<Tab>", "slide_in");
|
|
assign_to_key ("<Shift-Tab>", "slide_out");
|
|
assign_to_key ("<Space>", ".cob_abbrev");
|
|
assign_to_key ("<Ctrl-s>", "just_space");
|
|
_cob_template = inq_keyboard ();
|
|
keyboard_pop (1);
|
|
}
|
|
if (_cob_min_abbrev == 0)
|
|
{
|
|
use_local_keyboard (_cob_alt_template);
|
|
_cob_min_abbrev = 1;
|
|
}
|
|
else
|
|
use_local_keyboard (_cob_template);
|
|
|
|
returns ("");
|
|
}
|
|
|
|
/*
|
|
** When template editing is on, certain functions must be activated
|
|
** every time we switch to a COBOL file.
|
|
*/
|
|
|
|
string .cob_template_on ()
|
|
{
|
|
returns (.cob_smart_on ());
|
|
}
|
|
|
|
/*
|
|
** Some functions must be deactivated every time we leave a COBOL file.
|
|
*/
|
|
|
|
void .cob_smart_off ()
|
|
{
|
|
unregister_macro (ADD_CHAR_MACRO, ".cob_stmt_wrap");
|
|
use_tab_char (_cob_old_fill ? "y" : "n");
|
|
}
|
|
|
|
/*
|
|
** These definitions are used as Cobol "language sensitive" word patterns
|
|
*/
|
|
int .cob_next_word ()
|
|
{
|
|
returns (.c_next_word ());
|
|
}
|
|
|
|
int .cob_previous_word ()
|
|
{
|
|
returns (.c_previous_word ());
|
|
}
|
|
|
|
|
|
/*
|
|
** .cob_indent:
|
|
**
|
|
** This macro does syntax-sensitive indenting ("smart indenting") for
|
|
** COBOL language files.
|
|
**
|
|
** Parameters:
|
|
** 0 -- If FALSE, forces split mode (see below). If TRUE, forces
|
|
** non-split mode. If omitted, split mode depends on whether
|
|
** or not BRIEF is in insert mode.
|
|
**
|
|
** Returns:
|
|
** If the line was split, the number of whitespace
|
|
** characters trimmed from the middle.
|
|
*/
|
|
|
|
int .cob_indent (~int)
|
|
{
|
|
int curr_line, // Line cursor is on when called.
|
|
code_line, // Line number for last code.
|
|
code_indent_level, // Current indent level.
|
|
code_indent_col, // Current indent column.
|
|
code_trail, // Last code char on code line.
|
|
prev_indent_level, // Indent level of last line.
|
|
prev_trail, // Last code char before code line.
|
|
is_comment, // Is this line a comment?
|
|
is_para, // Is this line a paragraph name?
|
|
split_mode, // Should we insert a newline?
|
|
scratch; // Scratch integer.
|
|
|
|
string following_string, // Remainder of line being split.
|
|
code_text, // The trimmed version of the line.
|
|
prev_text, // The trimmed text of the previous line.
|
|
token; // First token in code_text.
|
|
|
|
/*
|
|
** Initialize. The default indent level is 0, which puts the
|
|
** cursor at COB_TEXT_COL??.
|
|
*/
|
|
|
|
inq_position (curr_line);
|
|
code_indent_col = _cob_seq_num ? COB_TEXT_COL74 : COB_TEXT_COL85;
|
|
code_trail = prev_trail = '.';
|
|
|
|
/*
|
|
** .cob_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, .cob_indent will add a new line to the buffer. The
|
|
** contents depend on the cursor position when .cob_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.
|
|
** If the old line is a comment, the new line will be a comment,
|
|
** and if the old line is code, the new line will be code.
|
|
**
|
|
** 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 .cob_indent to force
|
|
** it into either mode. If the parameter is FALSE, .cob_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. Make
|
|
** sure we handle splits in the prefix area correctly.
|
|
*/
|
|
|
|
if (split_mode && read (1) != "\n")
|
|
{
|
|
inq_position (NULL, scratch);
|
|
|
|
if (scratch < (_cob_seq_num ? COB_TEXT_COL74 : COB_TEXT_COL85))
|
|
move_abs (0, (_cob_seq_num ? COB_TEXT_COL74 : COB_TEXT_COL85));
|
|
|
|
following_string = read ();
|
|
following_string = substr (following_string, 1, strlen (following_string) - 1);
|
|
delete_to_eol ();
|
|
}
|
|
else
|
|
end_of_line ();
|
|
|
|
/*
|
|
** Find the beginning of the last code statement, and remember
|
|
** the text of the line, the first token, and the indent level.
|
|
*/
|
|
|
|
beginning_of_line ();
|
|
scratch = curr_line;
|
|
|
|
if (search_back ((_cob_seq_num ? COB_SKIP_PAT74 : COB_SKIP_PAT85), 1))
|
|
{
|
|
inq_position (code_line, code_indent_col);
|
|
code_indent_level = .cob_indent_level ();
|
|
code_text = upper (trim (read ()));
|
|
token = substr (code_text, 1, index (code_text + " ", " ") - 1);
|
|
code_trail = atoi (substr (code_text, strlen (code_text)), FALSE);
|
|
|
|
/*
|
|
** If we found one line of code, we look back for another.
|
|
*/
|
|
|
|
beginning_of_line ();
|
|
|
|
if (up () && search_back ((_cob_seq_num ? COB_SKIP_PAT74 : COB_SKIP_PAT85), 1))
|
|
{
|
|
prev_indent_level = .cob_indent_level ();
|
|
prev_text = upper (trim (read ()));
|
|
prev_trail = atoi (substr (prev_text, strlen (prev_text)), FALSE);
|
|
}
|
|
}
|
|
|
|
/*
|
|
** Figure out if the code is a paragraph name. Our working
|
|
** definition of a paragraph name is a single token (no spaces)
|
|
** preceded and followed by a period. The keywords EXIT, GOBACK,
|
|
** END- are exceptions.
|
|
*/
|
|
|
|
if (prev_trail == '.' && (token == code_text && ((substr (token, 1, 4) != "END-" && strlen (token))
|
|
&& (token != "EXIT." && token != "GOBACK."))))
|
|
is_para = TRUE;
|
|
|
|
move_abs (curr_line, 1);
|
|
|
|
/*
|
|
** If code_line is equal to curr_line, the line is a valid
|
|
** statement; if not, it's either a comment, an old-style
|
|
** continuation line (not supported) or syntactically invalid.
|
|
*/
|
|
|
|
if (code_line == curr_line)
|
|
|
|
/*
|
|
** If the statement began with an ELSE, it must be
|
|
** outdented to the matching IF. WHEN must be paired
|
|
** with a matching EVALUATE, then indented one level.
|
|
** THRU, VARYING, and UNTIL must be indented one level
|
|
** from the previous PERFORM.
|
|
*/
|
|
|
|
switch (token)
|
|
{
|
|
case "ELSE":
|
|
{
|
|
sprintf (prev_text, (_cob_seq_num ? COB_MATCH_PAT74 : COB_MATCH_PAT85), "IF");
|
|
.cob_outdent_to_match (prev_text, code_indent_level);
|
|
}
|
|
|
|
case "WHEN":
|
|
{
|
|
sprintf (prev_text, (_cob_seq_num ? COB_MATCH_PAT74 : COB_MATCH_PAT85), "EVALUATE");
|
|
.cob_outdent_to_match (prev_text, code_indent_level);
|
|
.cob_reindent (++code_indent_level);
|
|
}
|
|
case "THRU":
|
|
case "VARYING":
|
|
case "UNTIL":
|
|
switch (substr (prev_text, 1, index (prev_text + " ", " ") - 1))
|
|
{
|
|
case "PERFORM":
|
|
.cob_reindent (code_indent_level = prev_indent_level + 1);
|
|
|
|
case "THRU":
|
|
case "VARYING":
|
|
case "UNTIL":
|
|
if (code_indent_level != prev_indent_level)
|
|
.cob_reindent (code_indent_level = prev_indent_level);
|
|
}
|
|
/*
|
|
** FD, RD, and SD lines must be indented to level 0.
|
|
*/
|
|
|
|
case "FD":
|
|
case "RD":
|
|
case "SD":
|
|
.cob_reindent (code_indent_level = 0);
|
|
|
|
/*
|
|
** If the line begins with an END- keyword, we reindent
|
|
** it to the last matching keyword (for example, END-IF
|
|
** is aligned with the last IF). This matching will work
|
|
** fine as long as you consistently use END- keywords,
|
|
** rather than periods, to terminate nested constructs.
|
|
*/
|
|
|
|
default:
|
|
if (substr (token, 1, 4) == "END-")
|
|
{
|
|
prev_text = substr (token, 5);
|
|
|
|
if (substr (prev_text, strlen (prev_text)) == ".")
|
|
prev_text = substr (prev_text, 1, strlen (prev_text) - 1);
|
|
sprintf (prev_text, (_cob_seq_num ? COB_MATCH_PAT74 : COB_MATCH_PAT85), prev_text);
|
|
.cob_outdent_to_match (prev_text, code_indent_level);
|
|
}
|
|
|
|
/*
|
|
** If the line began with a number > 0, it may be a
|
|
** data description. These have special rules.
|
|
**
|
|
** Levels 01 and 77 are not indented at all.
|
|
**
|
|
** Other levels may be reindented, depending on the
|
|
** level number and current indenting level of both
|
|
** the current line and the previous line. Of course,
|
|
** if the previous line is not a data description,
|
|
** we don't reindent.
|
|
**
|
|
** If the two lines have the same level numbers,
|
|
** they should be aligned.
|
|
**
|
|
** If the previous line has a lower number, the
|
|
** current line should be indented beyond it; if it
|
|
** already is, fine, but if it's not, we indent one
|
|
** level. The converse is true if the code line has
|
|
** a lower number.
|
|
*/
|
|
|
|
else if (scratch = .cob_is_level_number (code_text))
|
|
|
|
/*
|
|
** If the level number is 1 or 77, we verify it and
|
|
** reindent the line.
|
|
*/
|
|
|
|
if (scratch == 1 || scratch == 77)
|
|
.cob_reindent (code_indent_level = 0);
|
|
else
|
|
{
|
|
int prev_level;
|
|
|
|
/*
|
|
** Now we make sure both lines began with
|
|
** real level numbers.
|
|
*/
|
|
|
|
if (prev_level = .cob_is_level_number (prev_text))
|
|
/*
|
|
** Now we reindent if necessary.
|
|
*/
|
|
{
|
|
scratch -= prev_level;
|
|
prev_level = code_indent_level;
|
|
|
|
if (!scratch)
|
|
code_indent_level = prev_indent_level;
|
|
else if (scratch > 0)
|
|
{
|
|
if (code_indent_level <= prev_indent_level)
|
|
code_indent_level = ++prev_indent_level;
|
|
}
|
|
else if (code_indent_level >= prev_indent_level)
|
|
code_indent_level = --prev_indent_level;
|
|
|
|
if (code_indent_level != prev_level)
|
|
.cob_reindent (code_indent_level);
|
|
}
|
|
}
|
|
/*
|
|
** If the current statement was a division, section,
|
|
** or paragraph name (single token ending in a period)
|
|
** we reindent it to level 0 (margin A).
|
|
**
|
|
** We assume the period comes right after DIVISION
|
|
** or SECTION.
|
|
*/
|
|
|
|
else if (code_trail == '.')
|
|
switch (substr (code_text, rindex (" " + code_text, " ")))
|
|
|
|
{
|
|
case "DIVISION.":
|
|
case "SECTION.":
|
|
.cob_reindent (code_indent_level = 0);
|
|
|
|
default:
|
|
if (is_para || token == "PROCEDURE")
|
|
.cob_reindent (code_indent_level = 0);
|
|
}
|
|
}
|
|
/*
|
|
** Determine if the current line is a comment.
|
|
*/
|
|
|
|
else
|
|
is_comment = .cob_is_comment ();
|
|
|
|
/*
|
|
** Move to the next line, splitting if necessary.
|
|
*/
|
|
|
|
if (split_mode)
|
|
{
|
|
end_of_line ();
|
|
insert ("\n");
|
|
|
|
/*
|
|
** If the current line was a comment, the new line should
|
|
** also be a comment.
|
|
*/
|
|
|
|
if (is_comment)
|
|
{
|
|
move_abs (0, (_cob_seq_num ? COB_CMT_COL74 : COB_CMT_COL85));
|
|
insert (COB_CMT_CHAR);
|
|
}
|
|
}
|
|
else
|
|
move_rel (1, NEG_MAX_COL);
|
|
|
|
/*
|
|
** Compute the cursor position on the next line. If the current
|
|
** line was a comment, the cursor position is controlled by
|
|
** _cob_comment_align.
|
|
**
|
|
** If the current line was code, we start with the same level, but
|
|
** indent if the statement contained certain keywords.
|
|
*/
|
|
|
|
if (is_comment && _cob_comment_align != CODE_ALIGN)
|
|
{
|
|
code_indent_level = _cob_seq_num ? COB_CMT_CONT_COL74 : COB_CMT_CONT_COL85;
|
|
|
|
if (_cob_comment_align == CMT_ALIGN)
|
|
{
|
|
save_position ();
|
|
|
|
if (up () && search_back ((_cob_seq_num ? COB_CMT_PAT74 : COB_CMT_PAT85), 1))
|
|
inq_position (NULL, code_indent_level);
|
|
|
|
restore_position ();
|
|
}
|
|
code_indent_level = 0 - code_indent_level;
|
|
}
|
|
|
|
else
|
|
switch (code_trail)
|
|
{
|
|
case '.':
|
|
/*
|
|
** When the code line ended with a period, and the
|
|
** previous line ended with one too, we are entering
|
|
** single-line sentences that don't change the indenting
|
|
** level. The only special case is a paragraph title,
|
|
** which causes an automatic indent.
|
|
**
|
|
** If the previous line ended with something else,
|
|
** we know we just finished a dangling statement. The
|
|
** correct indent level can be found by looking
|
|
** back for the beginning of the statement.
|
|
*/
|
|
|
|
if (prev_trail == '.')
|
|
{
|
|
if (is_para)
|
|
++code_indent_level;
|
|
}
|
|
else
|
|
code_indent_level = .cob_last_stmt_level (code_line);
|
|
|
|
case ',':
|
|
/*
|
|
** We assume commas are used in parameter lists, and
|
|
** a line ending with a comma probably represents a
|
|
** parameter in a list. The column where the last token
|
|
** on the line begins is a good place to put the cursor
|
|
** on the next line. We assume there are no spaces
|
|
** after the last token on the line, and no tabs in
|
|
** the line.
|
|
*/
|
|
|
|
code_indent_level = 0 - (code_indent_col + (rindex (" " + code_text, " ") - 1));
|
|
|
|
default:
|
|
|
|
/*
|
|
** On lines that do not end with periods or commas, the
|
|
** next indent level is controlled by the first keyword on
|
|
** the line (if any).
|
|
**
|
|
** We indent a level following IF, ELSE, and EVALUATE.
|
|
** We outdent a level following THRU, VARYING, or UNTIL
|
|
** (when we use these in combination, the line becomes
|
|
** reindented properly when we press <Enter>).
|
|
*/
|
|
|
|
switch (token)
|
|
{
|
|
case "ELSE":
|
|
case "EVALUATE":
|
|
case "IF":
|
|
++code_indent_level;
|
|
|
|
case "THRU":
|
|
case "VARYING":
|
|
case "UNTIL":
|
|
if (code_indent_level)
|
|
--code_indent_level;
|
|
|
|
default:
|
|
|
|
switch (prev_trail)
|
|
{
|
|
case '.':
|
|
++code_indent_level;
|
|
|
|
case ',':
|
|
code_indent_level = .cob_last_stmt_level (code_line);
|
|
}
|
|
}
|
|
}
|
|
|
|
/*
|
|
** Move the cursor.
|
|
*/
|
|
|
|
move_abs (0, code_indent_level >= 0 ? .cob_indent_level (code_indent_level) : 0 - code_indent_level);
|
|
|
|
/*
|
|
** Reinsert any characters we split.
|
|
*/
|
|
|
|
scratch = 0;
|
|
|
|
if (following_string != "")
|
|
{
|
|
save_position ();
|
|
scratch = strlen (following_string);
|
|
insert (following_string = ltrim (following_string));
|
|
restore_position ();
|
|
scratch -= strlen (following_string);
|
|
}
|
|
returns (scratch);
|
|
}
|
|
|
|
/*
|
|
** Outdents an END- keyword line until it pairs up with a matching
|
|
** begin keyword.
|
|
**
|
|
** Parameters:
|
|
** 0 -- the search pattern.
|
|
** 1 -- the current indenting level.
|
|
**
|
|
** Returns:
|
|
** Nothing.
|
|
**
|
|
** Puts the new indenting level, if it changes, back into parameter 1.
|
|
*/
|
|
|
|
int .cob_outdent_to_match (string match_pattern, int curr_indent_level)
|
|
{
|
|
int nesting;
|
|
|
|
save_position ();
|
|
nesting = 1;
|
|
|
|
/*
|
|
** Repeat until nesting is zero, or until we can't find another
|
|
** keyword in the search pattern. END- keywords increase the
|
|
** nesting level; other matches of the search pattern decrease it.
|
|
*/
|
|
|
|
while (nesting)
|
|
{
|
|
move_abs (0, MAX_COL);
|
|
|
|
if (!(up () && search_back (match_pattern, 1, 0)))
|
|
{
|
|
restore_position ();
|
|
return (FALSE);
|
|
}
|
|
if (upper (read (4)) == "END-")
|
|
++nesting;
|
|
else
|
|
--nesting;
|
|
}
|
|
/*
|
|
** We are on the matching begin keyword, and we assume that it
|
|
** is the first keyword on the line so that we can determine
|
|
** the line's indenting level. If the line with the END-
|
|
** keyword is indented to another level, reindent, reusing nesting
|
|
** since we don't need it any more.
|
|
*/
|
|
|
|
.cob_first_nonwhite ();
|
|
nesting = .cob_indent_level ();
|
|
restore_position ();
|
|
|
|
if (nesting != curr_indent_level)
|
|
{
|
|
.cob_reindent (nesting);
|
|
put_parm (1, nesting);
|
|
}
|
|
}
|
|
|
|
/*
|
|
** Finds the beginning of the last statement before a specified line,
|
|
** and returns its indenting level (following the convention that a
|
|
** negative indenting level is an absolute column number). Looks for
|
|
** the last line to end in a period, and saves the indent level of
|
|
** each line until it finds it so that one pass over the file is
|
|
** sufficient.
|
|
**
|
|
** Parameters:
|
|
** 0 -- The first line to look at (the number passed is excluded
|
|
** from the scan, which begins one line above it in the buffer).
|
|
*/
|
|
|
|
int .cob_last_stmt_level (int code_line)
|
|
{
|
|
int indent_col;
|
|
|
|
string line_text;
|
|
|
|
if (code_line)
|
|
{
|
|
save_position ();
|
|
move_abs (code_line, 1);
|
|
|
|
while (up () && search_back ((_cob_seq_num ? COB_SKIP_PAT74 : COB_SKIP_PAT85), 1))
|
|
{
|
|
line_text = trim (read ());
|
|
|
|
if (substr (line_text, strlen (line_text)) == ".")
|
|
break;
|
|
|
|
inq_position (NULL, indent_col);
|
|
}
|
|
restore_position ();
|
|
}
|
|
returns (0 - indent_col);
|
|
}
|
|
|
|
/*
|
|
** Determines if a line begins with a two-digit number. If so, reads the
|
|
** number from the line and returns it. Otherwise returns zero.
|
|
*/
|
|
|
|
int .cob_is_level_number (string line)
|
|
{
|
|
int retval;
|
|
|
|
if (retval = atoi (line))
|
|
if (substr (line, 3, 1) != " ")
|
|
retval = FALSE;
|
|
else if (!index ("0123456789", substr (line, 2, 1)))
|
|
retval = FALSE;
|
|
|
|
returns (retval);
|
|
}
|
|
|
|
/*
|
|
** Moves the cursor to the first non-space character in the text area.
|
|
*/
|
|
|
|
void .cob_first_nonwhite ()
|
|
{
|
|
move_abs (0, (_cob_seq_num ? COB_TEXT_COL74 : COB_TEXT_COL85));
|
|
next_char (strlen (read ()) - strlen (ltrim (read ())));
|
|
}
|
|
|
|
/*
|
|
** Maps between indent levels (in tab stops) and column positions in a
|
|
** COBOL file. The mapping accounts for the seven reserved columns
|
|
** at the beginning of each line: indent level 0 extends from column
|
|
** COB_TEXT_COL?? to just before the next tab stop, 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 .cob_indent_level (~int)
|
|
{
|
|
int curr_col,
|
|
level,
|
|
lev_to_col;
|
|
|
|
save_position ();
|
|
curr_col = _cob_seq_num ? COB_TEXT_COL74 : COB_TEXT_COL85;
|
|
|
|
if (get_parm (0, lev_to_col))
|
|
{
|
|
move_abs (0, (_cob_seq_num ? COB_TEXT_COL74 : COB_TEXT_COL85));
|
|
|
|
while (level < lev_to_col)
|
|
{
|
|
move_abs (0, curr_col += distance_to_tab ());
|
|
++level;
|
|
}
|
|
level = curr_col;
|
|
}
|
|
else
|
|
{
|
|
inq_position (NULL, lev_to_col);
|
|
move_abs (0, (_cob_seq_num ? COB_TEXT_COL74 : COB_TEXT_COL85));
|
|
|
|
while ((curr_col += distance_to_tab ()) <= lev_to_col)
|
|
{
|
|
move_abs (0, curr_col);
|
|
++level;
|
|
}
|
|
}
|
|
restore_position ();
|
|
returns (level);
|
|
}
|
|
|
|
/*
|
|
** Reindents the code part of a COBOL line to a specified level.
|
|
** If the line is already indented correctly, does nothing.
|
|
** Takes a single parameter, the level to reindent the line to.
|
|
*/
|
|
|
|
void .cob_reindent (int new_level)
|
|
{
|
|
.cob_first_nonwhite ();
|
|
|
|
if (new_level != .cob_indent_level ())
|
|
{
|
|
string temp;
|
|
|
|
temp = trim (read ());
|
|
move_abs (0, (_cob_seq_num ? COB_TEXT_COL74 : COB_TEXT_COL85));
|
|
delete_to_eol ();
|
|
move_abs (0, .cob_indent_level (new_level));
|
|
insert (temp);
|
|
.cob_stmt_wrap ();
|
|
}
|
|
}
|
|
|
|
/*
|
|
** Is a line a comment?
|
|
*/
|
|
|
|
int .cob_is_comment ()
|
|
{
|
|
int retval;
|
|
|
|
save_position ();
|
|
move_abs (0, (_cob_seq_num ? COB_CMT_COL74 : COB_CMT_COL85));
|
|
retval = COB_CMT_CHAR == read (1);
|
|
restore_position ();
|
|
returns (retval);
|
|
}
|
|
|
|
/*
|
|
** Toggle whether or not a line is a comment.
|
|
*/
|
|
|
|
void .cob_comment ()
|
|
{
|
|
save_position ();
|
|
move_abs (0, (_cob_seq_num ? COB_CMT_COL74 : COB_CMT_COL85));
|
|
|
|
if (.cob_is_comment ())
|
|
{
|
|
delete_char ();
|
|
insert (" ");
|
|
}
|
|
else
|
|
{
|
|
if (read (1) != "\n")
|
|
delete_char ();
|
|
|
|
insert (COB_CMT_CHAR);
|
|
}
|
|
restore_position ();
|
|
}
|
|
|
|
/*
|
|
** This registered macro checks to see if we have gone past column 72
|
|
** (for code lines) or column 80 (for comments) and breaks the line
|
|
** into two lines of the same type.
|
|
*/
|
|
|
|
void .cob_stmt_wrap ()
|
|
{
|
|
int col;
|
|
|
|
inq_position (NULL, col);
|
|
|
|
if (col > COB_RIGHT_MARGIN)
|
|
{
|
|
int split_col;
|
|
|
|
/*
|
|
** If the line's a comment, it may extend to column 80, so
|
|
** we just warn and return unless the line is even longer.
|
|
** If the line must still be split, we put the actual
|
|
** margin in split_col.
|
|
*/
|
|
|
|
if (.cob_is_comment ())
|
|
if (col <= COB_CMT_MARGIN)
|
|
{
|
|
beep ();
|
|
return;
|
|
}
|
|
else
|
|
split_col = COB_CMT_MARGIN;
|
|
else
|
|
split_col = COB_RIGHT_MARGIN;
|
|
|
|
/*
|
|
** Find the best split point for the line.
|
|
*/
|
|
|
|
col -= .cob_split_stmt (split_col);
|
|
|
|
/*
|
|
** Split the line. If spaces are trimmed from the line
|
|
** when we split it, compensate in the cursor positioning.
|
|
*/
|
|
|
|
col -= .cob_indent (FALSE);
|
|
|
|
/*
|
|
** Put the cursor back after the character that caused
|
|
** the split.
|
|
*/
|
|
|
|
next_char (col);
|
|
}
|
|
}
|
|
|
|
/*
|
|
** Find the best split point for a COBOL statement.
|
|
*/
|
|
|
|
int .cob_split_stmt (int max_split_col)
|
|
{
|
|
int split_col;
|
|
|
|
/*
|
|
** If we can't find a better splitting point, we will split
|
|
** the line at the last possible text character on the line.
|
|
*/
|
|
|
|
.cob_first_nonwhite ();
|
|
next_char ();
|
|
drop_anchor ();
|
|
move_abs (0, max_split_col);
|
|
|
|
/*
|
|
** We prefer to split lines at the beginning of a run of spaces
|
|
** or immediately after a comma.
|
|
*/
|
|
|
|
if (search_back ("{ +}|{,\\c?}", -2, NULL, 1))
|
|
{
|
|
inq_position (NULL, split_col);
|
|
move_abs (0, max_split_col);
|
|
}
|
|
raise_anchor ();
|
|
|
|
/*
|
|
** If we found no split column, or if the split was past the
|
|
** margin, split at the margin. Beep, as a warning.
|
|
*/
|
|
|
|
if (!split_col || split_col > max_split_col)
|
|
{
|
|
beep ();
|
|
split_col = max_split_col;
|
|
}
|
|
move_abs (0, split_col);
|
|
returns (split_col);
|
|
}
|
|
|
|
/*
|
|
** .cob_abbrev:
|
|
**
|
|
** This macro performs template expansion for COBOL. When it is
|
|
** invoked, the text area of the current line is checked to see if
|
|
** it matches the start of a reserved word or larger construct.
|
|
** If so, the remainder of the construct is filled in automatically.
|
|
**
|
|
** Expansion is only done when we're in the text area of a non-comment
|
|
** line, when there are 8 or fewer code characters on the line, and
|
|
** when we're at the end of the line. This makes expansion faster
|
|
** and avoids unwanted expansion.
|
|
*/
|
|
|
|
void .cob_abbrev ()
|
|
{
|
|
int done,
|
|
col;
|
|
|
|
/*
|
|
** Expand only when we're at the end of the line, and it's not
|
|
** a comment line.
|
|
*/
|
|
|
|
inq_position (NULL, col);
|
|
|
|
if ((col > (_cob_seq_num ? COB_TEXT_COL74 : COB_TEXT_COL85) && read (1) == "\n") && !.cob_is_comment ())
|
|
{
|
|
int loc;
|
|
|
|
string line,
|
|
which_abbrev,
|
|
completion;
|
|
|
|
/*
|
|
** If the last four characters in the buffer were " PIC",
|
|
** we realign the PIC to the proper column. If not, we
|
|
** check for a keyword that needs to be expanded. If we
|
|
** are already past the PIC column, we don't need to
|
|
** realign it.
|
|
*/
|
|
|
|
if (col < (_cob_seq_num ? COB_PIC_COL74 : COB_PIC_COL85) + 3)
|
|
{
|
|
move_abs (0, col - 4);
|
|
|
|
if (upper (read (4)) == " PIC")
|
|
{
|
|
.cob_reposition_keyword ();
|
|
inq_position (NULL, col);
|
|
move_abs (0, col -= 4);
|
|
|
|
while (++col < (_cob_seq_num ? COB_PIC_COL74 : COB_PIC_COL85))
|
|
insert (" ");
|
|
|
|
move_rel (0, 4);
|
|
insert (" ");
|
|
return;
|
|
}
|
|
move_abs (0, col);
|
|
}
|
|
/*
|
|
** Get a trimmed representation of the line into a string.
|
|
*/
|
|
|
|
save_position ();
|
|
move_abs (0, (_cob_seq_num ? COB_TEXT_COL74 : COB_TEXT_COL85));
|
|
loc = strlen (line = upper (trim (ltrim (read ()))));
|
|
|
|
/*
|
|
** Only do template expansion if the trimmed version
|
|
** of the line is at least _cob_min_abbrev characters long,
|
|
** at most 8 characters long, matches an expansion in
|
|
** ABBR_LIST, and is shorter than that token.
|
|
*/
|
|
|
|
if (line != "")
|
|
{
|
|
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;
|
|
}
|
|
|
|
|
|
/*
|
|
** Extract the full, expanded keyword from the
|
|
** abbreviation list, and make sure it's longer
|
|
** than the abbreviation.
|
|
*/
|
|
|
|
|
|
if ((loc <= 8) && (loc >= _cob_min_abbrev) && done && loc)
|
|
{
|
|
completion = substr (which_abbrev, ++done);
|
|
completion = substr (completion, 1, index (completion, "~") - 1);
|
|
|
|
if (loc < strlen (completion))
|
|
{
|
|
/*
|
|
** Delete the abbreviation from the buffer.
|
|
*/
|
|
|
|
.cob_first_nonwhite ();
|
|
col = .cob_indent_level ();
|
|
delete_to_eol ();
|
|
|
|
/*
|
|
** Insert each expanded keyword in context.
|
|
*/
|
|
|
|
switch (completion)
|
|
{
|
|
/*
|
|
** For each of the divisions, insert a full
|
|
** template including all standard sections
|
|
** and paragraphs, and a page eject. You
|
|
** can modify these strings to your own
|
|
** tastes.
|
|
*/
|
|
case "DATA":
|
|
{
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("DATA DIVISION.\n"));
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("FILE SECTION.\n\n"));
|
|
move_abs (0, COB_DIVISION);
|
|
save_position ();
|
|
insert (.cob_keyword_cvt ("WORKING-STORAGE SECTION.\n\n"));
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("LINKAGE SECTION.\n"));
|
|
move_abs (0, COB_DIVISION);
|
|
insert (COB_EJECT_CHAR);
|
|
restore_position ();
|
|
up ();
|
|
}
|
|
case "ENVIRONMENT":
|
|
{
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("ENVIRONMENT DIVISION.\n"));
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("CONFIGURATION SECTION.\n"));
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("SOURCE-COMPUTER. IBM-PERSONAL-COMPUTER.\n"));
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("OBJECT-COMPUTER. IBM-PERSONAL-COMPUTER.\n\n"));
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("INPUT-OUTPUT SECTION.\n"));
|
|
move_abs (0, COB_DIVISION);
|
|
save_position ();
|
|
insert (.cob_keyword_cvt ("FILE-CONTROL.\n\n"));
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt (COB_EJECT_CHAR));
|
|
restore_position ();
|
|
.cob_indent (TRUE);
|
|
}
|
|
|
|
case "IDENTIFICATION":
|
|
{
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("IDENTIFICATION DIVISION.\n"));
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("PROGRAM-ID. "));
|
|
|
|
/*
|
|
** This code automatically constructs a
|
|
** program name from the file name.
|
|
*/
|
|
|
|
inq_names (NULL, NULL, completion);
|
|
|
|
if (loc = index (completion, "."))
|
|
completion = substr (completion, 1, --loc);
|
|
|
|
insert (.cob_keyword_cvt (completion + ".\n"));
|
|
|
|
/*
|
|
** Modify these strings to insert
|
|
** your own name and installation
|
|
** information.
|
|
*/
|
|
|
|
if (_cob_ansi_85)
|
|
.cob_comment ();
|
|
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("AUTHOR. <YOUR NAME>.\n"));
|
|
|
|
if (_cob_ansi_85)
|
|
.cob_comment ();
|
|
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("INSTALLATION. <YOUR COMPANY>.\n"));
|
|
move_abs (0, COB_DIVISION);
|
|
|
|
/*
|
|
** We automatically insert today's
|
|
** date here.
|
|
*/
|
|
|
|
if (_cob_ansi_85)
|
|
.cob_comment ();
|
|
|
|
date (loc, NULL, col, completion);
|
|
sprintf (completion, "%s %d, %d.\n", upper (completion), col, loc);
|
|
insert (.cob_keyword_cvt ("DATE-WRITTEN. " + completion));
|
|
|
|
if (_cob_ansi_85)
|
|
.cob_comment ();
|
|
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("DATE-COMPILED. " + completion));
|
|
|
|
if (_cob_ansi_85)
|
|
.cob_comment ();
|
|
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("REMARKS. \n"));
|
|
move_abs (0, COB_DIVISION);
|
|
insert (COB_EJECT_CHAR + "\n");
|
|
move_abs (0, COB_DIVISION);
|
|
}
|
|
|
|
case "PROCEDURE":
|
|
{
|
|
move_abs (0, COB_DIVISION);
|
|
insert (.cob_keyword_cvt ("PROCEDURE DIVISION."));
|
|
left ();
|
|
}
|
|
/*
|
|
** The arithmetic operators require a
|
|
** second keyword, not counting GIVING,
|
|
** which is a separate template. Though
|
|
** COBOL 85 supports an END- keyword for
|
|
** each operator, those are seldom used.
|
|
**
|
|
** Many other verbs are most commonly
|
|
** used in a similar syntax.
|
|
*/
|
|
|
|
case "ADD":
|
|
case "MOVE":
|
|
case "SET":
|
|
.cob_expand_pair (completion, "TO");
|
|
|
|
case "CALL":
|
|
.cob_expand_pair (completion, "USING");
|
|
|
|
case "COMPUTE":
|
|
.cob_expand_pair (completion, "=");
|
|
|
|
case "DIVIDE":
|
|
.cob_expand_pair (completion, "INTO");
|
|
|
|
case "MULTIPLY":
|
|
.cob_expand_pair (completion, "BY");
|
|
|
|
case "SEARCH":
|
|
{
|
|
insert (.cob_keyword_cvt ("SEARCH"));
|
|
save_position ();
|
|
.cob_align ();
|
|
move_rel (0, distance_to_tab ());
|
|
insert (.cob_keyword_cvt (" WHEN \n"));
|
|
restore_position ();
|
|
right ();
|
|
}
|
|
case "SELECT":
|
|
.cob_expand_pair (completion, "ASSIGN TO");
|
|
|
|
case "SUBTRACT":
|
|
.cob_expand_pair (completion, "FROM");
|
|
|
|
/*
|
|
** ELSE may need to be outdented, and
|
|
** we want to continue entering text on
|
|
** the next line, so we just call
|
|
** .cob_indent in split mode.
|
|
*/
|
|
|
|
case "ELSE":
|
|
{
|
|
insert (.cob_keyword_cvt (completion));
|
|
.cob_indent (FALSE);
|
|
}
|
|
/*
|
|
** EVALUATE expands to a multi-line
|
|
** construct, with the default (WHEN
|
|
** OTHER) clause and END- keyword already
|
|
** inserted.
|
|
*/
|
|
|
|
case "EVALUATE":
|
|
{
|
|
insert (.cob_keyword_cvt (completion));
|
|
|
|
if (_cob_ansi_85)
|
|
{
|
|
.cob_first_nonwhite ();
|
|
inq_position (NULL, col);
|
|
.cob_align ();
|
|
save_position ();
|
|
move_rel (0, distance_to_tab ());
|
|
insert (.cob_keyword_cvt ("WHEN OTHER \n"));
|
|
move_abs (0, col);
|
|
insert (.cob_keyword_cvt ("END-EVALUATE") + " ");
|
|
restore_position ();
|
|
end_of_line ();
|
|
}
|
|
else
|
|
insert (" ");
|
|
}
|
|
/*
|
|
** EXIT almost always has a period after it.
|
|
*/
|
|
|
|
case "EXIT":
|
|
{
|
|
insert (.cob_keyword_cvt ("EXIT."));
|
|
.cob_indent (FALSE);
|
|
}
|
|
case "DELETE":
|
|
insert (.cob_keyword_cvt ("DELETE "));
|
|
|
|
case "GIVING":
|
|
insert (.cob_keyword_cvt ("GIVING "));
|
|
|
|
/*
|
|
** With ANSI 85 COBOL, we automatically
|
|
** insert a matching END-IF. We do the
|
|
** same for PERFORM.
|
|
*/
|
|
|
|
case "IF":
|
|
case "PERFORM":
|
|
.cob_expand_block (completion);
|
|
|
|
/*
|
|
** STRING and UNSTRING expand to a multi-line construct.
|
|
** For ANSI 85 COBOL, we line the INTO
|
|
** clause up with the DELIMITED BY
|
|
** clauses and use an END-STRING.
|
|
*/
|
|
case "UNSTRING":
|
|
case "STRING":
|
|
{
|
|
insert (.cob_keyword_cvt (completion));
|
|
save_position ();
|
|
.cob_first_nonwhite ();
|
|
inq_position (NULL, col);
|
|
.cob_align ();
|
|
move_rel (0, distance_to_tab ());
|
|
insert (.cob_keyword_cvt (" DELIMITED BY \n"));
|
|
move_abs (0, col);
|
|
|
|
if (_cob_ansi_85)
|
|
{
|
|
move_rel (0, distance_to_tab ());
|
|
insert (.cob_keyword_cvt ("INTO \n"));
|
|
move_abs (0, col);
|
|
insert (.cob_keyword_cvt ("END-STRING"));
|
|
}
|
|
else
|
|
insert (.cob_keyword_cvt ("INTO "));
|
|
|
|
restore_position ();
|
|
right ();
|
|
}
|
|
|
|
/*
|
|
** THRU checks to see if the last line
|
|
** was a PERFORM, and if so, it reads
|
|
** the paragraph name after the PERFORM,
|
|
** adds an -EXIT, and inserts it after
|
|
** the THRU.
|
|
**
|
|
** It also makes sure the THRU and PERFORM
|
|
** are properly lined up.
|
|
*/
|
|
|
|
case "THRU":
|
|
{
|
|
insert (.cob_keyword_cvt (completion));
|
|
.cob_reposition_keyword ();
|
|
insert (" ");
|
|
save_position ();
|
|
move_rel (-1, NEG_MAX_COL);
|
|
.cob_first_nonwhite ();
|
|
|
|
if (upper (read (7)) == "PERFORM")
|
|
{
|
|
move_rel (0, 7);
|
|
completion = ltrim (trim (read ())) + " ";
|
|
restore_position ();
|
|
insert (.cob_keyword_cvt (substr (completion, 1, index (completion, " ") - 1)));
|
|
insert (.cob_keyword_cvt ("-EXIT"));
|
|
}
|
|
else
|
|
restore_position ();
|
|
}
|
|
case "UNTIL":
|
|
{
|
|
insert (.cob_keyword_cvt (completion));
|
|
.cob_reposition_keyword ();
|
|
insert (" ");
|
|
}
|
|
/*
|
|
** Most PERFORM VARYING loops run from
|
|
** 1 by 1, so we insert that as a default.
|
|
*/
|
|
|
|
case "VARYING":
|
|
{
|
|
insert (.cob_keyword_cvt (completion));
|
|
.cob_reposition_keyword ();
|
|
save_position ();
|
|
insert (.cob_keyword_cvt (" FROM 1 BY 1"));
|
|
restore_position ();
|
|
right ();
|
|
}
|
|
|
|
/*
|
|
** Note: the "!" is an internal convention to ensure
|
|
** that the abbreviation length is less than the
|
|
** completion length.
|
|
*/
|
|
case "AG!":
|
|
.cob_expand_pair ("ADD", "TO GIVING");
|
|
|
|
/*
|
|
** Note: the "!" is an internal convention to ensure
|
|
** that the abbreviation length is less than the
|
|
** completion length.
|
|
*/
|
|
case "AE!":
|
|
{
|
|
insert (.cob_keyword_cvt ("AT END") + " ");
|
|
.cob_align ();
|
|
move_rel (0, distance_to_tab ());
|
|
}
|
|
|
|
/*
|
|
** Note: the "!" is an internal convention to ensure
|
|
** that the abbreviation length is less than the
|
|
** completion length.
|
|
*/
|
|
case "DF!":
|
|
.cob_expand_pair ("DELETE", "FILE");
|
|
|
|
/*
|
|
** Note: the "!" is an internal convention to ensure
|
|
** that the abbreviation length is less than the
|
|
** completion length.
|
|
*/
|
|
case "DG!":
|
|
.cob_expand_pair ("DIVIDE", "INTO GIVING REMAINDER");
|
|
|
|
/*
|
|
** Note: the "!" is an internal convention to ensure
|
|
** that the abbreviation length is less than the
|
|
** completion length.
|
|
*/
|
|
case "DR!":
|
|
.cob_expand_pair ("DELETE", "RECORD");
|
|
|
|
/*
|
|
** Note: the "!" is an internal convention to ensure
|
|
** that the abbreviation length is less than the
|
|
** completion length.
|
|
*/
|
|
case "MG!":
|
|
.cob_expand_pair ("MULTIPLY", "BY GIVING");
|
|
|
|
/*
|
|
** Note: the "!" is an internal convention to ensure
|
|
** that the abbreviation length is less than the
|
|
** completion length.
|
|
*/
|
|
case "SG!":
|
|
.cob_expand_pair ("SUBTRACT", "FROM GIVING");
|
|
|
|
/*
|
|
** Note: the "!" is an internal convention to ensure
|
|
** that the abbreviation length is less than the
|
|
** completion length.
|
|
*/
|
|
case "EC!":
|
|
{
|
|
insert (.cob_keyword_cvt ("EXEC CICS") + " ");
|
|
save_position ();
|
|
.cob_align ();
|
|
insert (.cob_keyword_cvt ("END-EXEC") + " ");
|
|
restore_position ();
|
|
}
|
|
|
|
default:
|
|
insert (.cob_keyword_cvt (completion) + " ");
|
|
}
|
|
}
|
|
|
|
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 () == _cob_alt_template)
|
|
slide_in ();
|
|
else
|
|
self_insert ();
|
|
}
|
|
|
|
/*
|
|
** Insert a pair of matching keywords, convert the case of the first
|
|
** one (it must be a verb) and place the cursor between them.
|
|
*/
|
|
|
|
void .cob_expand_pair (string keyword1, string keyword2)
|
|
{
|
|
insert (.cob_keyword_cvt (keyword1));
|
|
save_position ();
|
|
insert (" " + (.cob_keyword_cvt (keyword2) + " "));
|
|
restore_position ();
|
|
right ();
|
|
}
|
|
|
|
/*
|
|
** Reindents the current line if necessary, leaving the cursor
|
|
** at the end of the line.
|
|
*/
|
|
|
|
void .cob_reposition_keyword ()
|
|
{
|
|
.cob_indent (TRUE);
|
|
move_rel (-1, NEG_MAX_COL);
|
|
end_of_line ();
|
|
}
|
|
|
|
/*
|
|
** Inserts a matching END- keyword at the same level, below and in the
|
|
** same column as the expanded keyword. Only works for COBOL 85.
|
|
*/
|
|
|
|
void .cob_expand_block (string keyword)
|
|
{
|
|
insert (keyword = .cob_keyword_cvt (keyword));
|
|
|
|
if (_cob_ansi_85)
|
|
{
|
|
int col;
|
|
|
|
save_position ();
|
|
.cob_first_nonwhite ();
|
|
inq_position (NULL, col);
|
|
end_of_line ();
|
|
insert ("\n");
|
|
move_abs (0, col);
|
|
insert (.cob_keyword_cvt ("END-") + keyword);
|
|
restore_position ();
|
|
}
|
|
insert (" ");
|
|
}
|
|
|
|
/*
|
|
** 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 .cob_keyword_cvt (string keyword)
|
|
{
|
|
switch (_cob_keyword_case)
|
|
{
|
|
case KW_UPPER:
|
|
returns (upper (keyword));
|
|
|
|
case KW_LOWER:
|
|
returns (lower (keyword));
|
|
|
|
case KW_MIXED:
|
|
{
|
|
int space;
|
|
|
|
string retval;
|
|
|
|
keyword = upper (keyword);
|
|
|
|
while (space = search_string ("[ \\-]", keyword, NULL, 1))
|
|
{
|
|
/*
|
|
** Certain words in the NO_CAPS list do not get mixed
|
|
** capitalization.
|
|
*/
|
|
if (index (NO_CAPS, substr (keyword, 1, space - 1) + "~"))
|
|
retval += lower (substr (keyword, 1, space));
|
|
else
|
|
{
|
|
retval += substr (keyword, 1, 1);
|
|
retval += lower (substr (keyword, 2, space - 1));
|
|
}
|
|
keyword = substr (keyword, ++space);
|
|
}
|
|
if (index (NO_CAPS, substr (keyword, 1) + "~"))
|
|
retval += lower (keyword);
|
|
else
|
|
{
|
|
retval += substr (keyword, 1, 1);
|
|
retval += lower (substr (keyword, 2));
|
|
}
|
|
returns (retval);
|
|
}
|
|
}
|
|
}
|
|
|
|
/*
|
|
** Aligns the cursor to the next row, same column.
|
|
*/
|
|
void
|
|
.cob_align ()
|
|
{
|
|
int col;
|
|
|
|
.cob_first_nonwhite ();
|
|
inq_position (NULL, col);
|
|
end_of_line ();
|
|
insert ("\n");
|
|
move_abs (0, col);
|
|
}
|
|
|