/* ** 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. */ /* ** ** fortran.cb: ** ** Smart indenting and template editing for FORTRAN. ** */ #define FALSE 0 #define TRUE 1 #define FOR_CMT_CHAR "C" // Preferred comment character is C. #define FOR_CMT_LIST "Cc*$" // Legal comment chars are listed. #define FOR_CONT_CHAR "+" // Continuation character is +. #define FOR_CONT_LIST "123456789+*" // Legal continuation chars #define FOR_CMT_COL 1 // Comment char is in col 1. #define FOR_LABEL_COL 1 // Labels may start in col 2. #define FOR_CONT_COL 6 // Continuation char is in col 6. #define FOR_TEXT_COL 7 // Text starts in col 7. #define FOR_CMT_CONT_COL 7 // Continue comments at col 7. #define FOR_RIGHT_MARGIN 73 // Right margin is at col 72. #define FOR_CMT_MARGIN 81 // Comment margin is at col 80. #define CODE_ALIGN 0 // Where to indent comments. #define CMT_ALIGN 1 #define COL_ALIGN 2 #define CONT_LINE_LEV 2 #define FOR_SKIP_PAT "<[0-9 ]????[ 0] @\\c[~ ]" #define ABBR_LIST "~BLOCK DATA~COMMON~DO~DATA~ELSE~EI~ELSEIF~FORMAT~FUNCTION~IF~PROGRAM~READ~RETURN~SUBROUTINE~WRITE~" #define ADD_CHAR_MACRO 0 #define MIN_ABBREV 1 #define NEG_MAX_COL -20736 #define KW_LOWER 0 #define KW_UPPER 1 #define KW_MIXED 2 extern void slide_in (); extern void open_line (); extern int .c_previous_word (); extern int .c_next_word (); /* ** Function Prototypes */ string .for_smart_first (~int, ~int); string .for_smart_on (); string .for_template_first (~int, ~int, ~int); string .for_template_on (); void .for_smart_off (); int .for_indent (~int); int .for_next_indent (string, string); int .for_indent_level (~int); void .for_convert_label (int); void .for_reindent (int); int .for_is_comment (); int .for_is_contin (); void .for_comment (); void .for_stmt_wrap (); int .for_split_stmt (int); void .for_abbrev (); int .for_next_word (); int .for_previous_word (); string .for_keyword_cvt (string); void .for_expand_block (string); void .for_first_nonwhite (); /* ** Allocate the global variables and set up the keymaps. */ int _for_smart, _for_template, _for_alt_template, _for_keyword_case, _for_min_abbrev, _ada_keyword_case, _for_comment_align, _for_cont_align, _for_old_fill; /* ** Turn on smart indenting for FORTRAN. 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 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 FOR_CMT_CONT_COL. ** ** 1 -- The number of levels continuation lines should be indented ** relative to the start of the statement. ** ** Defaults: 0 2 */ string .for_smart_first (~int, ~int) { _for_comment_align = CODE_ALIGN; _for_cont_align = CONT_LINE_LEV; get_parm (0, _for_comment_align); get_parm (1, _for_cont_align); if (first_time()) { keyboard_push (); assign_to_key ("", ".for_indent"); assign_to_key ("", "slide_in"); assign_to_key ("", "slide_out"); _for_smart = inq_keyboard (); keyboard_pop (1); } use_local_keyboard (_for_smart); returns (""); } /* ** Turn on smart indenting for FORTRAN. This macro is designed to ** be run every time a FORTRAN file is edited. It turns on statement ** wrap for FORTRAN, and forces empty areas to be filled with spaces. */ string .for_smart_on () { register_macro (ADD_CHAR_MACRO, ".for_stmt_wrap"); _for_old_fill = "y" == use_tab_char ("n"); returns (".for_smart_off"); } /* ** Turn on template editing for FORTRAN. 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 -- Same as .for_smart_first. ** ** 2 -- The minimum prefix length required for template ** expansion. Set this parameter to 0 if you want to selectively ** expand templates by pressing . ** 3 -- controls case of expanded keywords. If this is 0, r ** expands to "return"; if 1, it expands to "RETURN"; and if 2, ** it expands to "Return". ** ** Defaults: 0 2 1 1 */ string .for_template_first (~int, ~int, ~int) { _for_comment_align = CODE_ALIGN; _for_cont_align = CONT_LINE_LEV; _for_min_abbrev = MIN_ABBREV; _for_keyword_case = KW_UPPER; get_parm (0, _for_comment_align); get_parm (1, _for_cont_align); get_parm (2, _for_min_abbrev); get_parm (3, _for_keyword_case); if (first_time()) { keyboard_push (); assign_to_key ("", ".for_indent"); assign_to_key ("", ".for_abbrev"); assign_to_key ("", "slide_out"); assign_to_key ("", "just_space"); _for_alt_template = inq_keyboard (); keyboard_pop (1); keyboard_push (); assign_to_key ("", ".for_indent"); assign_to_key ("", "slide_in"); assign_to_key ("", "slide_out"); assign_to_key ("", ".for_abbrev"); assign_to_key ("", "just_space"); _for_template = inq_keyboard (); keyboard_pop (1); } if (_for_min_abbrev == 0) { use_local_keyboard (_for_alt_template); _for_min_abbrev = 1; } else use_local_keyboard (_for_template); returns (""); } /* ** When template editing is on, certain functions must be activated ** every time we switch to a FORTRAN file. */ string .for_template_on () { returns (.for_smart_on ()); } /* ** Some functions must be deactivated every time we leave a FORTRAN file. */ void .for_smart_off () { unregister_macro (ADD_CHAR_MACRO, ".for_stmt_wrap"); use_tab_char (_for_old_fill ? "y" : "n"); } /* ** These definitions are used as Fortran "language sensitive" word patterns */ int .for_next_word () { returns (.c_next_word ()); } int .for_previous_word () { returns (.c_previous_word ()); } /* ** .for_indent: ** ** This macro does syntax-sensitive indenting ("smart indenting") for ** FORTRAN 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 .for_indent (~int) { int curr_line, // Line cursor is on when called. code_indent_level, // Current indent column. is_comment, // Is this line a comment? is_contin, // Is this line a continuation? split_mode, // Should we insert a newline? curr_col, // Current column insert_prefix = FALSE, // flag if insert in prefix area. scratch; // Scratch integer. string following_string, // Remainder of line being split. code_text, // Trimmed text of code line. prev_text, // Trimmed text of previous line. code_part; // Just the code on the line. /* ** Initialize. The default indent level is 0, which puts the ** cursor at FOR_TEXT_COL. */ inq_position (curr_line, curr_col); /* ** .for_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, .for_indent will add a new line to the buffer. The ** contents depend on the cursor position when .for_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 either a ** new code line or a continuation line. ** ** 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 .for_indent to force ** it into either mode. If the parameter is FALSE, .for_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") { /* ** If split in prefix area, yet not beginning of prefix area, ** split starting from the text column. */ if ((curr_col < FOR_TEXT_COL) && (curr_col > 1)) move_abs (0, FOR_TEXT_COL); /* ** If split at beginning of prefix area, set flag to later ** reinsert code in prefix area. */ else if (curr_col == FOR_LABEL_COL) insert_prefix = TRUE; following_string = read (); following_string = substr (following_string, 1, strlen (following_string) - 1); delete_to_eol (); } else end_of_line (); /* ** Determine if the current line is a comment. Blank lines are ** commented because they are illegal in FORTRAN. A negative ** value for is_comment means we made the line into a comment. */ beginning_of_line (); if ((trim (read ()) == "") || (curr_col == 1)) { delete_to_eol (); insert (FOR_CMT_CHAR); beginning_of_line (); is_comment = -1; } else is_comment = .for_is_comment (); /* ** Find the beginning of the last code statement, and remember ** the text of the line and its indent level. */ scratch = curr_line; if (search_back (FOR_SKIP_PAT, 1)) { inq_position (scratch); code_indent_level = .for_indent_level (); code_part = trim (read ()); } move_abs (curr_line, 1); code_text = trim (read ()); /* ** If the line is not a comment, see if it needs to be reindented. */ if (!is_comment) /* ** If the line is a continuation, read the continuation text ** into code_part, and reindent _for_cont_align levels ** right of code_indent_level. */ if (is_contin = .for_is_contin ()) { prev_text = code_part; code_part = ltrim (substr (code_text, FOR_TEXT_COL)); .for_reindent (code_indent_level + _for_cont_align); } /* ** If scratch is equal to curr_line, the line is a ** valid statement; if not, it's syntactically invalid. */ else if (scratch == curr_line) { /* ** If the line lacks a label, but the text part of the ** line begins with a number, convert that to a label. ** This lets us enter labeled statements quickly. */ if (atoi (code_part) && !atoi (substr (code_text, FOR_LABEL_COL, FOR_TEXT_COL - 1))) { .for_convert_label (code_indent_level); beginning_of_line (); code_text = trim (read ()); code_part = ltrim (substr (code_text, FOR_TEXT_COL)); } /* ** If the current statement began with an ELSE or END, ** it must be reindented one level left of the previous ** statement. If it began with a CONTINUE and a label, ** we look for a matching DO and reindent the line if ** we find one. */ switch (substr (code_part, 1, index (code_part + " ", " ") - 1)) { case "ELSE": case "END": case "ELSEIF": case "ENDIF": { up (); if (search_back (FOR_SKIP_PAT, 1)) scratch = .for_indent_level (); if (--scratch < 0) scratch = 0; move_abs (curr_line, 1); .for_reindent (code_indent_level = scratch); } case "CONTINUE": if (atoi (code_text)) { string temp; /* ** Search back for a DO statement with a ** matching label, but stop at the start ** of a PROGRAM, FUNCTION or SUBROUTINE ** unit, since we can't have one of those ** in the middle of a DO loop. */ sprintf (temp, "<[0-9 ]????{ @\\cDO @%d}|{* {PROGRAM}|{FUNCTION}|{SUBROUTINE}|{BLOCK DATA}}", atoi (code_text)); if (search_back (temp, 1, 1) && read (3) == "DO ") code_indent_level = .for_indent_level (); move_abs (curr_line, 1); .for_reindent (code_indent_level); } } } /* ** 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, unless the current line was converted ** from a blank line. If the current line was code, ** the new line should be a continuation. */ if (is_comment) { if (is_comment > 0) { move_abs (0, FOR_CMT_COL); insert (FOR_CMT_CHAR); } } else if (following_string != "") { move_abs (0, FOR_CONT_COL); insert (FOR_CONT_CHAR); } } else move_rel (1, NEG_MAX_COL); /* ** Position the cursor on the next line. If the current line ** was a comment, the cursor position is controlled by ** _for_comment_align. ** ** If the current line was code, we start with the same level, but ** indent if the statement contained certain keywords. However, ** if the new line is a continuation, the cursor goes at the ** beginning of the continued text. */ if (is_comment) { switch (_for_comment_align) { case CODE_ALIGN: { code_indent_level += .for_next_indent (code_part, code_part); move_abs (0, .for_indent_level (code_indent_level)); } case CMT_ALIGN: { save_position (); if (search_back ("<[Cc*$] +\\c[~ ]", 1)) inq_position (NULL, code_indent_level); else code_indent_level = FOR_CMT_CONT_COL; restore_position (); move_abs (0, code_indent_level); } case COL_ALIGN: move_abs (0, FOR_CMT_CONT_COL); } } else { if (.for_is_contin ()) code_indent_level += _for_cont_align; else code_indent_level += .for_next_indent (code_part, is_contin ? prev_text : code_part); move_abs (0, .for_indent_level (code_indent_level)); } /* ** Reinsert any characters we split. */ scratch = 0; if (following_string != "") { /* ** Reinsert in the prefix area */ if (insert_prefix) { move_abs (0, FOR_LABEL_COL); save_position (); scratch = strlen (following_string); insert (following_string); restore_position (); } /* ** Reinsert in the text area */ else { save_position (); scratch = strlen (following_string); insert (following_string = ltrim (following_string)); restore_position (); scratch -= strlen (following_string); } } returns (scratch); } /* ** Computes the indent level of the next line based on its parameters, ** which are the code part of the last line of the statement and ** the code part of the first line of the statement. The lines may ** be the same (and usually are). ** ** Returns 1 if the indent level of the next line should be increased, ** or 0 if it should remain the same. */ int .for_next_indent (string code_part1, string code_part2) { switch (substr (code_part1, rindex (" " + code_part1, " "))) { case "ELSE": case "THEN": returns (1); default: returns ("DO" == substr (code_part2, 1, index (code_part2 + " ", " ") - 1)); } } /* ** Maps between indent levels (in tab stops) and column positions in a ** FORTRAN file. The mapping accounts for the six reserved columns ** at the beginning of each line: indent level 0 extends from column ** FOR_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 .for_indent_level (~int) { int curr_col, level, lev_to_col; save_position (); curr_col = FOR_TEXT_COL; if (get_parm (0, lev_to_col)) { move_abs (0, FOR_TEXT_COL); 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, FOR_TEXT_COL); while ((curr_col += distance_to_tab ()) <= lev_to_col) { move_abs (0, curr_col); ++level; } } restore_position (); returns (level); } /* ** Given a line with a label in the text area, convert it to a "standard ** FORTRAN" line, with the label in its own area. Simplifies the entry ** of labeled lines. */ void .for_convert_label (int level) { move_abs (0, FOR_LABEL_COL); drop_anchor (4); move_abs (0, FOR_TEXT_COL); search_fwd ("[0-9]", 1, NULL, 0); delete_block (); search_fwd ("[~0-9]", 1); insert (" "); while (distance_to_tab () > 1) insert (" "); .for_reindent (level); } /* ** Reindents the code part of a FORTRAN line to a specified level. ** If the line is already indented correctly, does nothing. */ void .for_reindent (int new_level) { move_abs (0, FOR_TEXT_COL); search_fwd ("[~ ]", 1); if (new_level != .for_indent_level ()) { string temp; temp = trim (read ()); move_abs (0, FOR_TEXT_COL); delete_to_eol (); move_abs (0, .for_indent_level (new_level)); insert (temp); } } /* ** Is a line a comment? */ int .for_is_comment () { int retval; save_position (); move_abs (0, FOR_CMT_COL); retval = index (FOR_CMT_LIST, read (1)); restore_position (); returns (retval); } /* ** Is a line a continuation? */ int .for_is_contin () { int retval; save_position (); move_abs (0, FOR_CONT_COL); retval = index (FOR_CONT_LIST, read (1)); restore_position (); returns (retval); } /* ** Toggle whether or not a line is a comment. */ void .for_comment () { save_position (); move_abs (0, FOR_CMT_COL); if (.for_is_comment ()) { delete_char (); insert (" "); } else { if (read (1) != "\n") delete_char (); insert (FOR_CMT_CHAR); } restore_position (); } /* ** This registered macro checks to see if we have gone past column 72, ** and if we have, it breaks the line. If the line is code, it makes ** it into a properly indented continuation line. If the line is ** a comment, it continues it. */ void .for_stmt_wrap () { int col; inq_position (NULL, col); if (col > FOR_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 (.for_is_comment ()) if (col <= FOR_CMT_MARGIN) { beep (); return; } else split_col = FOR_CMT_MARGIN; else split_col = FOR_RIGHT_MARGIN; /* ** Find the best split point for the line. */ col -= .for_split_stmt (split_col); /* ** Split the line. If spaces are trimmed from the line ** when we split it, compensate in the cursor positioning. */ col -= .for_indent (0); /* ** Put the cursor back after the character that caused ** the split. */ next_char (col); } } /* ** Find the best split point for a FORTRAN statement. */ int .for_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. */ move_abs (0, FOR_TEXT_COL); search_fwd ("[~ ]", 1); 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. Failing that, we will split at ** the first of a run of opening parentheses, after a closing ** parenthesis, plus sign, equals sign or hyphen, or after a logical ** operator like .GT. Failing that, we will split after a quote, ** slash, or asterisk. */ if (search_back ("{ +}|{,\\c?}", -2, NULL, 1)) { inq_position (NULL, split_col); move_abs (0, max_split_col); } if (!split_col && search_back ("{(+}|{[)\\-+=]|{[A-Z].}\\c?}", -2, NULL, 1)) { inq_position (NULL, split_col); move_abs (0, max_split_col); } if (!split_col && 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); } /* ** .for_abbrev: ** ** This macro performs template expansion for FORTRAN. When it is ** invoked, the text area of the current line is checked to see if ** it matches the start of an IF...THEN or other FORTRAN statement. ** If so, the remainder of the statement is filled in automatically. ** ** Expansion is only done when we're in the text area of a non-comment, ** non-continuation line, when there are 6 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 .for_abbrev () { int done, col; /* ** Expand only when we're at the end of the line, and it's not ** a comment or continuation line. */ inq_position (NULL, col); if ((col >= FOR_TEXT_COL && read (1) == "\n") && !(.for_is_comment () || .for_is_contin ())) { int loc; string completion; /* ** Get a trimmed representation of the line into a string. */ save_position (); move_abs (0, FOR_TEXT_COL); loc = strlen (completion = (upper (trim (ltrim (read ()))))); /* ** Only do template expansion if the trimmed version ** of the line is at least _for_min_abbrev characters long, ** at most 6 characters long, matches an expansion in ** ABBR_LIST, and is shorter than that token. */ if ((loc <= 6 && loc >= _for_min_abbrev) && (done = index (ABBR_LIST, "~" + 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); if (completion == "EI") completion = "ELSEIF"; if (loc < strlen (completion)) { /* ** Delete the abbreviation from the buffer, and ** replace it with the expanded version. */ move_abs (0, FOR_TEXT_COL); search_fwd ("[~ ]", 1); col = .for_indent_level (); delete_to_eol (); insert ( .for_keyword_cvt (completion)); /* ** Insert necessary context for each keyword. */ switch (completion) { case "BLOCK DATA": case "FUNCTION": case "PROGRAM": case "SUBROUTINE": { .for_expand_block ("END"); insert (" "); } case "DO": /* ** Make up a unique label based on the ** current line number. */ { inq_position (loc); sprintf (completion, " %d \n %d CONTINUE", loc, loc); insert (.for_keyword_cvt (completion)); .for_convert_label (col); up (); end_of_line (); } case "ELSE": .for_indent (0); case "ELSEIF": { .for_indent (1); up (); end_of_line (); insert (.for_keyword_cvt (" () THEN")); move_rel (0, -6); } case "IF": { insert (" ("); .for_expand_block ("ENDIF"); insert (.for_keyword_cvt (") THEN")); move_rel (0, -6); } 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 () == _for_alt_template) slide_in (); else self_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 .for_keyword_cvt (string keyword) { switch (_for_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)); } } } /* ** Moves the cursor to the first character on the current line that ** is not a space or a tab. */ void .for_first_nonwhite () { move_abs (0, FOR_TEXT_COL); next_char (strlen (read ()) - strlen (ltrim (read ()))); } /* ** Insert a matching keyword at the same level. ** */ void .for_expand_block (string end) { int column; save_position (); .for_indent (0); move_rel (-1, FOR_TEXT_COL); .for_first_nonwhite (); inq_position (NULL, column); move_rel (1, NEG_MAX_COL); insert ("\n"); move_abs (0, column); insert (.for_keyword_cvt (end)); restore_position (); }