v04i105: TPUVI for VMS part 14 of 17
Gregg Wonderly
gregg at a.cs.okstate.edu
Wed Sep 28 08:18:30 AEST 1988
Posting-number: Volume 4, Issue 105
Submitted-by: "Gregg Wonderly" <gregg at a.cs.okstate.edu>
Archive-name: vms-vi-2/Part14
$ WRITE SYS$OUTPUT "Creating ""VI.10"""
$ CREATE VI.10
$ DECK/DOLLARS=$$EOD$$
coff;
coff := CURRENT_OFFSET;
cline := vi$cur_line_no;
IF (LENGTH (vi$current_line) > 0) THEN
IF (CURRENT_OFFSET < LENGTH(vi$current_line)) THEN
MOVE_HORIZONTAL (1);
ENDIF;
ENDIF;
vi$insert_here;
vi$undo_offset := coff;
vi$undo_line := cline;
ENDPROCEDURE;
!
! A do nothing function
!
PROCEDURE vi$_dummy
ENDPROCEDURE;
!
! Do the command line input processing
!
PROCEDURE vi$while_not_esc
LOCAL
max_mark,
start_pos,
max_col;
max_col := CURRENT_OFFSET;
start_pos := max_col;
max_mark := MARK(NONE);
vi$update (CURRENT_WINDOW);
RETURN (vi$line_edit (max_col, start_pos, max_mark, 0));
ENDPROCEDURE;
!
! Insert text into the buffer using standard VI insertion.
! Used by CHANGE, APPEND, INSERT, and REPLACE functions.
!
PROCEDURE vi$line_edit (max_col, start_pos, max_mark, replace)
LOCAL
chcnt,
offset,
seen_eol,
col,
cnt,
tabstops,
current_mark,
desc,
start_ins,
ins_text,
should_wrap,
abbrs,
rchar,
abbrlen,
cabbr,
cmode,
pos,
did_ai,
in_char;
ON_ERROR
ENDON_ERROR;
! If show mode is in effect the show the mode.
IF (vi$show_mode) THEN
vi$mess_select (BOLD);
MESSAGE (FAO ("!7* INSERT"));
vi$mess_select (REVERSE);
ENDIF;
chcnt := 0;
seen_eol := 0;
! Get the list of current abbreviation variable names.
abbrs := EXPAND_NAME ("vi$abbr_", VARIABLES) + " ";
cabbr := "";
abbrlen := 0;
! Now decide whether we are entering from a change or replace command
! verses an insert or append command. If it is change or replace, then
! we must set the buffer to overstrike so that we can type over things
! until we get to the right marker, max_col.
SET (INSERT, CURRENT_BUFFER);
IF (max_col > CURRENT_OFFSET) OR (replace <> 0) THEN
SET (OVERSTRIKE, CURRENT_BUFFER);
ENDIF;
! Save the starting position for repeat_last_typed_text.
start_ins := MARK (NONE);
! Add the initial auto indent margin.
chcnt := vi$do_auto_indent(0);
did_ai := (chcnt <> 0);
IF (did_ai) THEN
max_col := CURRENT_OFFSET;
max_mark := MARK (NONE);
ENDIF;
LOOP ! Until escape is pressed.
LOOP ! Until we are not reinserting previously typed text.
in_char := vi$read_a_key;
desc := LOOKUP_KEY (KEY_NAME (in_char), COMMENT, vi$edit_keys);
IF (desc = "entab") THEN
IF (vi$auto_indent = 0) THEN
EXITIF (1);
ENDIF;
vi$do_entab;
max_col := CURRENT_OFFSET;
max_mark := MARK (NONE);
ELSE
IF (desc = "detab") THEN
IF (vi$auto_indent = 0) THEN
EXITIF (1);
ENDIF;
vi$do_detab;
max_col := CURRENT_OFFSET;
max_mark := MARK (NONE);
ELSE
EXITIF (desc <> "reinsert");
IF max_mark <> MARK (NONE) THEN
current_mark := MARK (NONE);
POSITION (max_mark);
MOVE_HORIZONTAL (-1);
ERASE (CREATE_RANGE (MARK (NONE), current_mark, NONE));
ENDIF;
SET (INSERT, CURRENT_BUFFER);
COPY_TEXT (vi$last_insert);
APPEND_LINE;
max_col := CURRENT_OFFSET;
start_pos := CURRENT_OFFSET;
max_mark := MARK(NONE);
chcnt := chcnt + 1;
ENDIF;
ENDIF;
ENDLOOP;
! Out when escape is pressed.
EXITIF desc = "escape";
! Catch maps.
IF (desc = "active_macro") THEN
EXECUTE (LOOKUP_KEY (KEY_NAME (in_char), PROGRAM, vi$edit_keys));
ELSE
! If this is a typing key....
IF (desc <> "eol") AND (desc <> "bword") AND (desc <> "bs") THEN
! Check if :set wm is in effect, and we are at the right margin.
should_wrap := (vi$wrap_margin <> 0) AND
((CURRENT_OFFSET + vi$wrap_margin) > vi$scr_width);
! If we should do line wrapping.
IF (should_wrap) THEN
! Backup over the last word.
offset := 0;
MOVE_HORIZONTAL (-1);
LOOP
EXITIF (CURRENT_OFFSET = 0);
EXITIF (INDEX (vi$_space_tab, CURRENT_CHARACTER) <> 0);
MOVE_HORIZONTAL (-1);
offset := offset + 1;
ENDLOOP;
! Trim off the white space.
IF (offset <> 0) THEN
ERASE_CHARACTER (1);
LOOP
EXITIF (CURRENT_OFFSET = 0);
MOVE_HORIZONTAL (-1);
EXITIF (
INDEX (vi$_space_tab, CURRENT_CHARACTER) = 0);
ERASE_CHARACTER (1);
ENDLOOP;
ENDIF;
! Split the line at the proper place, and reset the
! markers.
IF (CURRENT_OFFSET <> 0) THEN
MOVE_HORIZONTAL (1);
SPLIT_LINE;
max_col := CURRENT_OFFSET;
start_pos := CURRENT_OFFSET;
max_mark := MARK(NONE);
MOVE_HORIZONTAL (offset);
ELSE
MOVE_HORIZONTAL (offset);
SPLIT_LINE;
max_col := CURRENT_OFFSET;
start_pos := CURRENT_OFFSET;
max_mark := MARK(NONE);
ENDIF;
! After spliting, put in the left margin.
did_ai := (vi$do_auto_indent(1) <> 0);
ENDIF;
! Make sure the window is up to date.
vi$update (CURRENT_WINDOW);
! If the key was ^V then read another.
IF desc = "vquote" THEN
COPY_TEXT ("^");
MOVE_HORIZONTAL (-1);
vi$update (CURRENT_WINDOW);
in_char := vi$read_a_key;
IF (GET_INFO (CURRENT_BUFFER, "MODE") = INSERT) THEN
ERASE_CHARACTER (1);
ENDIF;
ENDIF;
! Insert a tab?
IF in_char = TAB_KEY THEN
! Check for a completed abbreviation.
vi$abbr (abbrs, 0, cabbr, abbrlen);
! Check whether to use a tab or expand to spaces.
IF (vi$use_tabs = 1) THEN
COPY_TEXT (ASCII (9));
ELSE
cnt := 0;
col := GET_INFO (SCREEN, "CURRENT_COLUMN");
tabstops := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");
IF (GET_INFO (tabstops, "TYPE") <> STRING) THEN
LOOP
EXITIF (col - ((col / tabstops) *
tabstops) = 0);
cnt := cnt + 1;
col := col + 1;
ENDLOOP;
chcnt := chcnt + cnt;
LOOP
EXITIF (cnt < 0);
IF (CURRENT_OFFSET = max_col) AND
((replace = 0) OR seen_eol) THEN
SET (INSERT, CURRENT_BUFFER);
ELSE
IF CURRENT_OFFSET > max_col THEN
max_col := CURRENT_OFFSET;
max_mark := MARK (NONE);;
ENDIF;
ENDIF;
COPY_TEXT (" ");
cnt := cnt - 1;
ENDLOOP
ELSE
! Give up on windows with weird tab stops.
COPY_TEXT (ASCII (9));
ENDIF;
ENDIF;
chcnt := chcnt + 1;
ELSE
! If it is a CONTROL key, then normalize the value to be
! 1-26.
in_char := INT (in_char);
IF (in_char <= INT(CTRL_Z_KEY)) AND
(in_char >= INT(CTRL_A_KEY)) THEN
in_char := (in_char - INT(CTRL_A_KEY)) /
(INT(CTRL_B_KEY) - INT(CTRL_A_KEY)) + 1;
ENDIF;
! Get the character we really want to insert.
rchar := vi$ascii(in_char);
! If the character is a word separator, then check to see
! if an abbreviation preceeded this key.
IF (INDEX (vi$_ws, rchar) <> 0) THEN
chcnt := chcnt + vi$abbr (abbrs, rchar, cabbr, abbrlen);
ELSE
! Otherwise put the character into the buffer.
COPY_TEXT (rchar);
! Add the current character to the string that is
! going to contain the trailing portion of the variable
! name for the abbreviation.
IF (INDEX(vi$_upper_chars, rchar) <> 0) THEN
cabbr := cabbr + "_";
ENDIF;
cabbr := cabbr + rchar;
abbrlen := abbrlen + 1;
! Count the number of characters typed in.
chcnt := chcnt + 1;
ENDIF;
ENDIF;
! See if time to make the transition from OVERSTRIKE to
! INSERT modes.
IF (CURRENT_OFFSET = max_col) AND
((replace = 0) OR seen_eol) THEN
SET (INSERT, CURRENT_BUFFER);
ELSE
! Move the indicators up when necessary.
IF CURRENT_OFFSET > max_col THEN
max_col := CURRENT_OFFSET;
max_mark := MARK (NONE);
ENDIF;
ENDIF;
ELSE
! Check for a backspace.
IF desc = "bs" THEN
! If it is possible to backspace.
IF start_pos < CURRENT_OFFSET THEN
! Delete backspace and the character before it in
! the key buffer that is remembering all of the
! keystrokes typed.
vi$del_a_key;
vi$del_a_key;
! Transition back to overstrike.
SET (OVERSTRIKE, CURRENT_BUFFER);
! Backspace on the screen, and decrement char count.
MOVE_HORIZONTAL (-1);
chcnt := chcnt - 1;
ENDIF;
ELSE
! Check for RETURN.
IF desc = "eol" THEN
! If not up to the max_mark, then there is trailing
! text to erase, so do that first.
IF (max_mark <> MARK (NONE)) AND (replace = 0) THEN
current_mark := MARK (NONE);
POSITION (max_mark);
MOVE_HORIZONTAL (-1);
ERASE (CREATE_RANGE (MARK (NONE),
current_mark, NONE));
ENDIF;
! Now check for an abbreviation, and inc the count..
chcnt := vi$abbr (abbrs, 0, cabbr, abbrlen) + 1;
! Split the line
SPLIT_LINE;
! Set flag for REPLACE so that we do not write over
! unreplaced, but overstruck text.
seen_eol := 1;
! Check for the DCL buffer activity
IF (CURRENT_BUFFER = vi$dcl_buf) AND (vi$send_dcl) THEN
MOVE_VERTICAL (-1);
vi$send_to_dcl (CURRENT_LINE);
MOVE_VERTICAL (1);
ENDIF;
! Update all of the indicators and transition to
! INSERT mode.
max_col := CURRENT_OFFSET;
start_pos := CURRENT_OFFSET;
max_mark := MARK(NONE);
SET (INSERT, CURRENT_BUFFER);
! Add left margin if needed.
did_ai := (vi$do_auto_indent(1) <> 0);
! End of input if DCL buffer and flag set.
IF (CURRENT_BUFFER = vi$dcl_buf) AND (vi$send_dcl) THEN
EXITIF (1);
ENDIF;
ELSE
! Check for CTRL-W, backup over word.
IF (desc = "bword") THEN
! Backup over whitespace.
LOOP
EXITIF start_pos = CURRENT_OFFSET;
MOVE_HORIZONTAL (-1);
chcnt := chcnt - 1;
EXITIF (INDEX (vi$_space_tab,
CURRENT_CHARACTER) = 0);
SET (OVERSTRIKE, CURRENT_BUFFER);
ENDLOOP;
! Backup over nonblank chars.
LOOP
EXITIF start_pos = CURRENT_OFFSET;
SET (OVERSTRIKE, CURRENT_BUFFER);
IF (INDEX (vi$_space_tab,
CURRENT_CHARACTER) <> 0) THEN
chcnt := chcnt + 1;
MOVE_HORIZONTAL (1);
EXITIF (1);
ENDIF;
MOVE_HORIZONTAL (-1);
chcnt := chcnt - 1;
ENDLOOP;
ENDIF;
ENDIF;
ENDIF;
ENDIF;
ENDIF;
! Make sure everything is visible.
vi$update (CURRENT_WINDOW);
ENDLOOP;
! Must get a new offset for the cursor now.
vi$new_offset := 1;
! If we are not at the rightmost position that text was typed to, then
! we must delete the garbage out to the right.
IF max_mark <> MARK (NONE) THEN
current_mark := MARK (NONE);
! If we are in REPLACE, then the text out there should be replaced
! with the stuff that was there originally.
IF (NOT seen_eol) AND (replace <> 0) THEN
SET (OVERSTRIKE, CURRENT_BUFFER);
COPY_TEXT (SUBSTR (replace, CURRENT_OFFSET + 1,
max_col - CURRENT_OFFSET));
POSITION (current_mark);
ELSE
! Otherwise we erase the stuff.
POSITION (max_mark);
IF (MARK(NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (-1);
ENDIF;
ERASE (CREATE_RANGE (MARK (NONE), current_mark, NONE));
ENDIF;
ENDIF;
! When INSERT is ended, the cursor moves back one position, providing
! we are not at the beginning of the line.
IF (MARK(NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
IF (chcnt <> 0) THEN
MOVE_HORIZONTAL (-1);
ENDIF;
ELSE
chcnt := 0;
ENDIF;
! Save the text that we typed for later repeat.
ins_text := CREATE_RANGE (start_ins, MARK (NONE), NONE);
! Save last inserted text to buffer.
ERASE (vi$last_insert);
pos := MARK (NONE);
POSITION (vi$last_insert);
COPY_TEXT (ins_text);
SPLIT_LINE;
POSITION (BEGINNING_OF (vi$last_insert));
POSITION (pos);
SET (INSERT, CURRENT_BUFFER);
! If :set sm, then remove the MODE displayed.
IF (vi$show_mode) THEN
MESSAGE ("");
ENDIF;
! Function value is approximately the number of characters typed. This
! is mainly for check for NONE verses SOME.
RETURN (chcnt);
ENDPROCEDURE;
!
! Create the initial left margin of auto indent.
!
PROCEDURE vi$do_auto_indent(forceit)
LOCAL
d_rng,
d_strt,
d_text,
pos,
istr;
ON_ERROR
RETURN (0);
ENDON_ERROR;
IF (vi$auto_indent = 0) THEN
RETURN;
ENDIF;
IF (LENGTH (CURRENT_LINE) > 0) AND (forceit = 0) THEN
RETURN;
ENDIF;
pos := MARK (NONE);
MOVE_VERTICAL (-1);
d_strt := MARK (NONE);
istr := vi$get_leading_blank;
d_text := (CURRENT_CHARACTER = "");
IF (CURRENT_OFFSET > 0) THEN
MOVE_HORIZONTAL (-1);
d_rng := CREATE_RANGE (d_strt, MARK(NONE), NONE);
ELSE
d_rng := 0;
ENDIF;
POSITION (pos);
POSITION (LINE_BEGIN);
COPY_TEXT (istr);
POSITION (pos);
IF (d_text) AND (d_rng <> 0) THEN
ERASE (d_rng);
ENDIF;
vi$update (CURRENT_WINDOW);
RETURN (LENGTH (istr));
ENDPROCEDURE;
!
! Insert another tab while :set ai is active.
!
PROCEDURE vi$do_entab
vi$do_ai_tabbing (1);
ENDPROCEDURE;
!
! Remove a tab while :set ai is active.
!
PROCEDURE vi$do_detab
vi$do_ai_tabbing (0);
ENDPROCEDURE;
!
! Get the leading whitespace from the current line. Used during :set ai
! to findout how to indent on the current line.
!
PROCEDURE vi$get_leading_blank
LOCAL
ln,
ch,
idx;
ln := vi$current_line;
rstr := "";
idx := 1;
LOOP
ch := SUBSTR (ln, idx, 1);
IF (ch = "") THEN
RETURN (rstr);
ENDIF;
EXITIF (INDEX (vi$_space_tab, ch) = 0);
rstr := rstr + ch;
idx := idx + 1;
ENDLOOP;
RETURN (rstr);
ENDPROCEDURE;
!
! Check the current line, and see if it is completely whitespace to
! determine how to alter its indention.
!
PROCEDURE vi$check_leading_blank
LOCAL
ln,
ch,
idx;
ln := vi$current_line;
idx := 1;
LOOP
ch := SUBSTR (ln, idx, 1);
IF (ch = "") THEN
RETURN (1);
ENDIF;
EXITIF (INDEX (vi$_space_tab, ch) = 0);
idx := idx + 1;
ENDLOOP;
RETURN (0);
ENDPROCEDURE;
!
! Do :set ai entabbing or detabbing.
!
PROCEDURE vi$do_ai_tabbing (mode)
LOCAL
needed,
copy_line,
exitnow,
cur_tabs,
tab_len;
IF NOT vi$check_leading_blank THEN
vi$beep;
RETURN;
ENDIF;
cur_tabs := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");
IF (GET_INFO (cur_tabs, "TYPE") = STRING) THEN
vi$info ("Can't do auto indent in buffer with uneven tabstops.");
RETURN;
ELSE
tab_len := cur_tabs;
ENDIF;
exitnow := 0;
copy_line := vi$current_line;
IF (copy_line <> "") OR (mode = 1) THEN
! Copy line is truncated to have no leading spaces.
needed := vi$vis_indent (copy_line, tab_len);
IF mode = 1 THEN
needed := needed + vi$shift_width;
ELSE
needed := needed - vi$shift_width;
ENDIF;
IF (needed < 0) THEN
needed := 0;
ENDIF;
ERASE_LINE;
COPY_TEXT (vi$get_tabs (needed, tab_len)+copy_line);
MOVE_HORIZONTAL (1);
IF (MARK (NONE) <> END_OF(CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (-1);
SPLIT_LINE;
ENDIF;
MOVE_HORIZONTAL (-1);
vi$update (CURRENT_WINDOW);
ELSE
vi$beep;
ENDIF;
ENDPROCEDURE;
!
! Check to see if 'cabbr' is a known abbreviation, and substitute the
! proper text if it is.
!
PROCEDURE vi$abbr (abbrs, rchar, cabbr, abbrlen)
LOCAL
strg;
strg := "";
IF (abbrlen > 0) THEN
EDIT (cabbr, UPPER);
IF (INDEX (abbrs, "VI$ABBR_"+cabbr+" ") <> 0) THEN
vi$global_var := 0;
EXECUTE (COMPILE ("vi$global_var := vi$abbr_"+cabbr+";"));
IF (vi$global_var <> 0) THEN
ERASE_CHARACTER (-abbrlen);
strg := vi$global_var;
COPY_TEXT (strg);
ENDIF;
ENDIF;
cabbr := "";
abbrlen := 0;
ENDIF;
IF (rchar <> 0) THEN
COPY_TEXT (rchar);
ENDIF;
RETURN (LENGTH (strg) + (rchar <> 0));
ENDPROCEDURE;
!
! Return a string describing the KEY_NAME passed. For control characters,
! it is "^?" where the '?' is A-Z. Otherwise, the value returned by the
! ASCII() builtin is used.
!
PROCEDURE vi$ascii_name (key_n)
LOCAL
key;
key := key_n;
IF (GET_INFO (key, "TYPE") = KEYWORD) THEN
key := INT (key);
ENDIF;
key := (key - INT(CTRL_A_KEY)) / (INT(CTRL_B_KEY) - INT(CTRL_A_KEY));
IF (key > 31) OR (key < 0) THEN
key := ASCII (key_n);
ELSE
key := "^" + ASCII(key+65);
ENDIF;
RETURN (key);
ENDPROCEDURE;
!
! Perform some mapping of keys to different ASCII values.
!
PROCEDURE vi$ascii (key_n)
IF key_n = F12 THEN
RETURN (ASCII (8));
ENDIF;
IF key_n = F11 THEN
RETURN (ASCII (27));
ENDIF;
IF key_n = PF1 THEN
RETURN (ASCII (27));
ENDIF;
IF key_n = RET_KEY THEN
RETURN (ASCII (13));
ENDIF;
IF key_n = TAB_KEY THEN
RETURN (ASCII (9));
ENDIF;
RETURN (ASCII (key_n));
ENDPROCEDURE;
!
! Move up by screens
!
PROCEDURE vi$prev_screen
ON_ERROR
ENDON_ERROR;
MOVE_VERTICAL (-vi$cur_active_count *
GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH"));
vi$beep_position (vi$first_no_space(0), 0, 1);
ENDPROCEDURE;
!
! Move down by screens
!
PROCEDURE vi$next_screen
ON_ERROR
ENDON_ERROR;
MOVE_VERTICAL (vi$cur_active_count *
(GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH") + 2));
vi$beep_position (vi$first_no_space(0), 0, 1);
ENDPROCEDURE;
!
! Scroll forward one screen
!
PROCEDURE vi$screen_forward
vi$scroll_screen (1);
ENDPROCEDURE;
!
! Scroll back one screen
!
PROCEDURE vi$screen_backward
vi$scroll_screen (-1);
ENDPROCEDURE;
!
! Scroll the screen up or down depending on the sign of "how_many_screens"
! The magnitude actually has effect as well, but is never greater than 1
! in this use.
!
PROCEDURE vi$scroll_screen (how_many_screens)
LOCAL
scroll_window, ! Window to be scrolled
this_window, ! Current window
this_column, ! Current column in scroll_window
this_row, ! Current row in scroll_window
old_scroll_top, ! Original value of scroll_top
old_scroll_bottom, ! Original value of scroll_bottom
old_scroll_amount; ! Original value of scroll_amount
! Trap and ignore messages about move beyond buffer boundaries -
! just move to top or bottom line of buffer
ON_ERROR
ENDON_ERROR;
this_window := CURRENT_WINDOW;
scroll_window := this_window;
IF vi$active_count <> 0 THEN
vi$how_much_scroll := vi$cur_active_count;
ENDIF;
this_row := GET_INFO (scroll_window, "CURRENT_ROW");
IF this_row = 0 THEN
this_row := GET_INFO (scroll_window, "VISIBLE_TOP");
ENDIF;
this_column := GET_INFO (scroll_window, "CURRENT_COLUMN");
POSITION (LINE_BEGIN);
old_scroll_top := GET_INFO (scroll_window, "SCROLL_TOP");
old_scroll_bottom := GET_INFO (scroll_window, "SCROLL_BOTTOM");
old_scroll_amount := GET_INFO (scroll_window, "SCROLL_AMOUNT");
SET (SCROLLING, scroll_window, ON,
this_row - GET_INFO (scroll_window, "VISIBLE_TOP"),
GET_INFO (scroll_window, "VISIBLE_BOTTOM") - this_row, 0);
MOVE_VERTICAL (how_many_screens * vi$how_much_scroll);
vi$update (scroll_window);
IF this_window <> CURRENT_WINDOW THEN
POSITION (this_window);
ENDIF;
SET (SCROLLING, scroll_window, ON, old_scroll_top, old_scroll_bottom,
old_scroll_amount);
ENDPROCEDURE;
!
! Move forward logical words
!
PROCEDURE vi$_word_forward
vi$beep_position (vi$word_move (1), 0, 1);
ENDPROCEDURE;
!
! Move backward logical words
!
PROCEDURE vi$_word_back
vi$beep_position (vi$word_move(-1), 0, 1);
ENDPROCEDURE;
!
! Move by logical word taking into account the repeat count
!
PROCEDURE vi$word_move(dir)
LOCAL
old_pos,
pos;
old_pos := MARK (NONE);
IF vi$active_count <= 0 THEN
vi$active_count := 1;
ENDIF;
LOOP
pos := vi$move_logical_word (dir);
EXITIF pos = 0;
POSITION (pos);
vi$active_count := vi$active_count - 1;
EXITIF vi$active_count = 0;
ENDLOOP;
vi$yank_mode := VI$IN_LINE_MODE;
RETURN (vi$retpos (old_pos));
ENDPROCEDURE;
!
! Move to end of logical word
!
PROCEDURE vi$_word_end
vi$beep_position (vi$word_end, 0, 1);
ENDPROCEDURE;
!
! Move to end of physical word
!
PROCEDURE vi$_full_word_end
vi$beep_position (vi$full_word_end, 0, 1);
ENDPROCEDURE;
!
! Move to the end of the current word.
!
PROCEDURE vi$word_end
LOCAL
old_pos,
pos;
old_pos := MARK (NONE);
IF vi$active_count <= 0 THEN
vi$active_count := 1;
ENDIF;
LOOP
pos := vi$move_logical_end;
EXITIF pos = 0;
POSITION (pos);
vi$active_count := vi$active_count - 1;
EXITIF vi$active_count = 0;
ENDLOOP;
vi$yank_mode := VI$IN_LINE_MODE;
RETURN (vi$retpos (old_pos));
ENDPROCEDURE;
!
! Move to the end of a blank (eol is also considered blank) terminated word.
!
PROCEDURE vi$full_word_end
LOCAL
old_pos,
pos;
old_pos := MARK (NONE);
IF vi$active_count <= 0 THEN
vi$active_count := 1;
ENDIF;
LOOP
pos := vi$move_full_end;
EXITIF pos = 0;
POSITION (pos);
vi$active_count := vi$active_count - 1;
EXITIF vi$active_count = 0;
ENDLOOP;
vi$yank_mode := VI$IN_LINE_MODE;
RETURN (vi$retpos (old_pos));
ENDPROCEDURE;
!
! Move forward by ONE white-space delimited word
!
PROCEDURE vi$_full_word_forward
vi$beep_position (vi$full_word_move (1), 0, 1);
ENDPROCEDURE;
!
!
! Move backward by ONE white-space delimited word
!
PROCEDURE vi$_full_word_back
vi$beep_position (vi$full_word_move (-1), 0, 1);
ENDPROCEDURE;
!
! Move by physical word taking the repeat count into account
!
PROCEDURE vi$full_word_move (dir)
LOCAL
old_pos,
pos;
old_pos := MARK (NONE);
IF vi$active_count <= 0 THEN
vi$active_count := 1;
ENDIF;
LOOP
pos := vi$move_full_word (dir);
EXITIF pos = 0;
POSITION (pos);
vi$active_count := vi$active_count - 1;
EXITIF vi$active_count = 0;
ENDLOOP;
vi$yank_mode := VI$IN_LINE_MODE;
RETURN (vi$retpos (old_pos));
ENDPROCEDURE;
!
! Move the cursor by BLANK separated words. DIRECTION is either
! +1, or -1 to indicate the direction (forward, or backword respectfully)
! to move
!
PROCEDURE vi$move_full_word (direction)
LOCAL
typ,
pos;
pos := MARK (NONE);
IF (direction = -1) THEN
LOOP
EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER));
MOVE_HORIZONTAL (-1);
typ := vi$get_type (CURRENT_CHARACTER);
EXITIF (typ <> VI$SPACE_TYPE) AND (typ <> VI$EOL_TYPE);
ENDLOOP;
ENDIF;
LOOP
EXITIF ((MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND
(direction = -1));
EXITIF ((MARK (NONE) = END_OF (CURRENT_BUFFER)) AND
(direction = 1));
EXITIF (CURRENT_CHARACTER = "");
EXITIF vi$get_type (CURRENT_CHARACTER) = VI$SPACE_TYPE;
MOVE_HORIZONTAL (direction);
ENDLOOP;
! A hack to make change work like it is supposed to with "cw".
IF (vi$command_type = VI$CHANGE_TYPE) AND (direction = 1) THEN
vi$new_endpos := MARK (NONE);
ENDIF;
IF (direction = 1) THEN
LOOP
EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
EXITIF (CURRENT_CHARACTER = "") AND
(vi$command_type <> VI$OTHER_TYPE);
MOVE_HORIZONTAL (1);
EXITIF vi$get_type (CURRENT_CHARACTER) <> VI$SPACE_TYPE;
ENDLOOP;
ELSE
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (1);
ENDIF;
ENDIF;
RETURN (vi$retpos(pos));
ENDPROCEDURE;
!
! Move the cursor by logical words. Note that words in this case are
! delimited by a change from one type of character to another. The
! predefined types
!
! VI$ALPHA_TYPE, VI$PUNCT_TYPE, and VI$SPACE_TYPE
!
! are used to detect transitions from one word to the next;
!
PROCEDURE vi$move_logical_word (direction)
LOCAL
this_type,
this_char,
typec,
pos;
pos := MARK (NONE);
! If direction is back, then skip SPACE characters until no space
! is found.
IF (direction = -1) THEN
LOOP
EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER));
MOVE_HORIZONTAL (-1);
typec := vi$get_type (CURRENT_CHARACTER);
EXITIF (typec <> VI$SPACE_TYPE) AND (typec <> VI$EOL_TYPE);
ENDLOOP;
ENDIF;
IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
this_char := CURRENT_CHARACTER;
this_type := vi$get_type (this_char);
ENDIF;
LOOP
EXITIF ((MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND
(direction = -1));
EXITIF ((MARK (NONE) = END_OF (CURRENT_BUFFER)) AND
(direction = 1));
MOVE_HORIZONTAL (direction);
EXITIF (vi$get_type (CURRENT_CHARACTER) <> this_type);
ENDLOOP;
! A hack to make change work like it is supposed to with "cw".
IF (vi$command_type = VI$CHANGE_TYPE) AND (direction = 1) THEN
vi$new_endpos := MARK (NONE);
ENDIF;
IF (direction = 1) THEN
LOOP
EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND
(direction = -1);
EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER)) AND
(direction = 1);
typec := vi$get_type(CURRENT_CHARACTER);
EXITIF (typec < VI$SPACE_TYPE);
EXITIF (vi$command_type <> VI$OTHER_TYPE) AND
(typec <> VI$SPACE_TYPE);
MOVE_HORIZONTAL (1);
EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
ENDLOOP;
ELSE
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (1);
ENDIF;
ENDIF;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! Move the cursor by BLANK separated words. DIRECTION is either
! +1, or -1 to indicate the direction (forward, or backword respectfully)
! to move
!
PROCEDURE vi$move_full_end
LOCAL
ctype,
pos;
pos := MARK (NONE);
IF (pos = END_OF (CURRENT_BUFFER)) THEN
RETURN (0);
ENDIF;
LOOP
MOVE_HORIZONTAL (1);
EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
ctype := vi$get_type (CURRENT_CHARACTER);
EXITIF (ctype <> VI$SPACE_TYPE) AND (ctype <> VI$EOL_TYPE);
ENDLOOP;
LOOP
EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
ctype := vi$get_type (CURRENT_CHARACTER);
EXITIF (ctype = VI$EOL_TYPE) OR (ctype = VI$SPACE_TYPE);
MOVE_HORIZONTAL (1);
ENDLOOP;
MOVE_HORIZONTAL (-1);
RETURN (vi$retpos(pos));
ENDPROCEDURE;
!
! Move the cursor by logical words. Note that words in this case are
! delimited by a change from one type of character to another. The
! predefined types
!
! VI$ALPHA_TYPE, VI$PUNCT_TYPE, and VI$SPACE_TYPE
!
! are used to detect transitions from one word to the next;
!
PROCEDURE vi$move_logical_end
LOCAL
ctype,
this_type,
this_char,
pos;
pos := MARK (NONE);
IF (pos = END_OF (CURRENT_BUFFER)) THEN
RETURN (0);
ENDIF;
LOOP
MOVE_HORIZONTAL (1);
EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
ctype := vi$get_type (CURRENT_CHARACTER);
EXITIF (ctype <> VI$SPACE_TYPE) AND (ctype <> VI$EOL_TYPE);
ENDLOOP;
this_char := CURRENT_CHARACTER;
this_type := vi$get_type (this_char);
LOOP
EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
EXITIF (CURRENT_CHARACTER) = "";
EXITIF (vi$get_type (CURRENT_CHARACTER) <> this_type);
MOVE_HORIZONTAL (1);
ENDLOOP;
MOVE_HORIZONTAL (-1);
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! Return the logical type of the character passed. This is typically used
! by the move_by_word routines to determine when a word ends.
!
PROCEDURE vi$get_type (this_char)
LOCAL
this_type;
IF (this_char = "") THEN
RETURN (VI$EOL_TYPE);
ENDIF;
this_type := VI$SPACE_TYPE;
IF (INDEX (vi$_alpha_chars, this_char) <> 0) THEN
this_type := VI$ALPHA_TYPE;
ELSE
IF (INDEX (vi$_punct_chars, this_char) <> 0) THEN
this_type := VI$PUNCT_TYPE;
ENDIF;
ENDIF;
RETURN (this_type);
ENDPROCEDURE;
!
! This procedure determines what line the cursor is currently positioned
! on. and then prints that information, along with other items of interest
! in the message window.
!
PROCEDURE vi$what_line
LOCAL
bmode,
percent,
mod,
outfile,
lines,
nowr,
pos,
cnt;
ON_ERROR;
lines := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
IF (cnt) > lines THEN
cnt := lines;
ENDIF;
IF lines = 0 THEN
percent := 0;
ELSE
percent := (cnt*100)/lines;
ENDIF;
vi$info (FAO ("!ASLine !UL of !UL, !UL%, !AS!AS!AS",
nowr, cnt, lines, percent, bmode, mod, outfile));
SET (TIMER, OFF);
RETURN;
ENDON_ERROR;
IF (vi$getbufmode (CURRENT_BUFFER)) THEN
bmode := "[readonly] ";
ELSE
bmode := "";
ENDIF;
nowr := " ";
IF (GET_INFO (CURRENT_BUFFER, "NO_WRITE")) AND (bmode = "") THEN
nowr := "*";
ENDIF;
mod := "";
IF GET_INFO (CURRENT_BUFFER, "MODIFIED") THEN
mod := "[modified] ";
ENDIF;
pos := MARK(NONE);
POSITION (LINE_BEGIN);
cnt := 0;
lines := 0;
outfile := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
IF (outfile = 0) THEN
outfile := "Not Edited";
ELSE
outfile := """"+outfile+"""";
ENDIF;
cnt := vi$cur_line_no;
POSITION (pos);
lines := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
IF (cnt) > lines THEN
cnt := lines;
ENDIF;
IF lines = 0 THEN
percent := 0;
ELSE
percent := (cnt*100)/lines;
ENDIF;
vi$info (FAO ("!ASLine !UL of !UL, !UL%, !AS!AS!AS",
nowr, cnt, lines, percent, bmode, mod, outfile));
SET (TIMER, OFF);
ENDPROCEDURE;
!
PROCEDURE vi$file_info
LOCAL
bmode,
outfile;
IF (vi$getbufmode (CURRENT_BUFFER)) THEN
bmode := "[readonly] ";
ELSE
bmode := "";
ENDIF;
outfile := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
IF (outfile = 0) THEN
outfile := "Not Edited";
ELSE
outfile := """"+outfile+"""";
ENDIF;
vi$info (FAO ("!AS!AS !UL lines", outfile, bmode,
GET_INFO (CURRENT_BUFFER, "RECORD_COUNT")));
ENDPROCEDURE;
!
! This function moves to "pos" if it is non-zero. If "pos" is zero, then
! any current macro is aborted, and the current position is not changed.
! "save_pos" is a boolean value that indicates whether or not the current
! location is remembered so that it can be returned to later with the
! "'" (go to marker) command.
!
PROCEDURE vi$beep_position (pos, save_pos, dobeep)
IF (pos <> 0) THEN
IF save_pos THEN
vi$old_place := MARK (NONE);
ENDIF;
POSITION (pos);
ELSE
IF dobeep THEN
vi$beep;
ENDIF;
RETURN (vi$abort (0));
ENDIF;
RETURN (pos);
ENDPROCEDURE;
!
! This function implements the command mode function of joining the
! current line with the one below it.
!
! The undo operation consists of deleting the line created by joining
! the two lines, and then inserting the original contents of the two
! joined lines.
!
PROCEDURE vi$_join_lines
LOCAL
start,
spos,
epos,
pos,
plen,
len;
ON_ERROR
! Throw away moved beyond end of buffer messages.
RETURN;
ENDON_ERROR;
spos := MARK (NONE);
POSITION (LINE_BEGIN);
pos := MARK (NONE);
IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
MOVE_VERTICAL (1);
IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
MOVE_VERTICAL (1);
MOVE_HORIZONTAL (-1);
epos := MARK (NONE);
POSITION (spos);
vi$save_for_undo (CREATE_RANGE (pos, epos, NONE),
VI$LINE_MODE, 1);
POSITION (pos);
ELSE
RETURN;
ENDIF;
ELSE
RETURN;
ENDIF;
POSITION (LINE_END);
LOOP
EXITIF (CURRENT_OFFSET = 0);
MOVE_HORIZONTAL (-1);
EXITIF INDEX (vi$_space_tab, CURRENT_CHARACTER) = 0;
ERASE_CHARACTER (1);
ENDLOOP;
a plen := LENGTH (vi$current_line);
vi$_next_line;
IF (CURRENT_OFFSET > 0) AND (plen > 0) THEN
ERASE_CHARACTER (-CURRENT_OFFSET);
ENDIF;
len := LENGTH (vi$current_line);
APPEND_LINE;
IF (len > 0) AND (plen > 0) THEN
COPY_TEXT (" ");
MOVE_HORIZONTAL (-1);
ELSE
vi$check_rmarg;
ENDIF;
pos := MARK (NONE);
POSITION (LINE_BEGIN);
vi$undo_start := MARK (NONE);
POSITION (LINE_END);
vi$undo_end := MARK (NONE);
POSITION (pos);
ENDPROCEDURE;
!
! This function filters the selected region through the command
! given.
!
PROCEDURE vi$region_filter
LOCAL
era_range,
prog,
nchar,
$$EOD$$
More information about the Comp.sources.misc
mailing list