v04i100: TPUVI for VMS part 9 of 17
Gregg Wonderly
gregg at a.cs.okstate.edu
Tue Sep 27 11:54:42 AEST 1988
Posting-number: Volume 4, Issue 100
Submitted-by: "Gregg Wonderly" <gregg at a.cs.okstate.edu>
Archive-name: vms-vi-2/Part09
$ WRITE SYS$OUTPUT "Creating ""VI.5"""
$ CREATE VI.5
$ DECK/DOLLARS=$$EOD$$
next_key := vi$read_a_key;
EXITIF INDEX (vi$_numeric_chars, ASCII (next_key)) = 0;
vi$active_count := vi$active_count * 10 +
INT (ASCII (KEY_NAME (next_key)));
ENDLOOP;
IF (next_key = F11) OR ((next_key <> RET_KEY) AND
(next_key <> KEY_NAME ('.')) AND
(next_key <> KEY_NAME ('+')) AND
(next_key <> KEY_NAME ('-'))) THEN
vi$active_count := 0;
RETURN;
ENDIF;
IF (vi$active_count > 0) AND (next_key <> KEY_NAME ('.')) THEN
vi$old_place := MARK (NONE);
pos := vi$to_line (vi$active_count);
ELSE
pos := MARK (NONE);
ENDIF;
cur_window := CURRENT_WINDOW;
scroll_top := GET_INFO (cur_window, "SCROLL_TOP");
scroll_bottom := GET_INFO (cur_window, "SCROLL_BOTTOM");
scroll_amount := GET_INFO (cur_window, "SCROLL_AMOUNT");
done := 0;
IF next_key = KEY_NAME ('-') THEN
scrl_value := (GET_INFO (cur_window, "VISIBLE_LENGTH") / 2);
SET (SCROLLING, cur_window, ON, scrl_value, scrl_value, scrl_value);
POSITION (pos);
vi$update (cur_window);
done := 1;
ELSE
IF next_key = KEY_NAME ('+') THEN
scrl_value := GET_INFO (cur_window, "VISIBLE_LENGTH");
SET (SCROLLING, cur_window, ON, scrl_value, scrl_value, scrl_value);
POSITION (pos);
vi$update (cur_window);
done := 1;
ELSE
IF next_key = RET_KEY THEN
vi$do_set_window (vi$cur_active_count);
scrl_value := GET_INFO (cur_window, "VISIBLE_LENGTH");
SET (SCROLLING, cur_window, ON, 0, scrl_value, scrl_value);
POSITION (pos);
vi$update (cur_window);
done := 1;
ELSE
IF next_key = KEY_NAME ('.') THEN
vi$pos_in_middle (MARK (NONE));
done := 0;
ENDIF;
ENDIF;
ENDIF;
ENDIF;
IF (done) THEN
SET (SCROLLING, cur_window, ON, scroll_top, scroll_bottom,
scroll_amount);
ENDIF;
ENDPROCEDURE;
!
! Perform the 'r' command
!
PROCEDURE vi$_replace_char
LOCAL
act_cnt,
key,
pos;
ON_ERROR;
POSITION (pos);
RETURN;
ENDON_ERROR;
pos := MARK (NONE);
act_cnt := vi$cur_active_count;
IF (vi$show_mode) THEN
vi$mess_select (BOLD);
MESSAGE (FAO ("!7* REPLACE"));
vi$mess_select (REVERSE);
ENDIF;
key := vi$read_a_key;
IF (key = F11) THEN
IF (vi$show_mode) THEN
MESSAGE ("");
ENDIF;
RETURN;
ENDIF;
IF (key = TAB_KEY) THEN
key := ASCII (9);
ELSE
IF (key = RET_KEY) THEN
key := ASCII (13);
ELSE
IF (key = DEL_KEY) THEN
key := ASCII (8);
ELSE
key := ASCII (key);
ENDIF;
ENDIF;
ENDIF;
IF ((CURRENT_OFFSET + act_cnt) <= LENGTH (vi$current_line)) THEN
IF (key = ASCII (13)) THEN
MOVE_HORIZONTAL (act_cnt);
ELSE
MOVE_HORIZONTAL (act_cnt - 1);
ENDIF;
vi$save_for_undo (CREATE_RANGE (pos, MARK(NONE), NONE),
VI$IN_LINE_MODE, 1);
IF (key = ASCII (13)) THEN
MOVE_HORIZONTAL (-act_cnt);
ELSE
MOVE_HORIZONTAL (-(act_cnt-1));
ENDIF;
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (-1);
vi$undo_start := MARK (NONE);
MOVE_HORIZONTAL (1);
ELSE
vi$undo_start := 0;
ENDIF;
SET (OVERSTRIKE, CURRENT_BUFFER);
LOOP
IF (key = ASCII (13)) THEN
SPLIT_LINE;
ERASE_CHARACTER (1);
ELSE
COPY_TEXT (key);
ENDIF;
act_cnt := act_cnt - 1;
EXITIF act_cnt = 0;
ENDLOOP;
IF (key = ASCII (13)) THEN
MOVE_HORIZONTAL (1);
ENDIF;
MOVE_HORIZONTAL (-1);
vi$undo_end := MARK (NONE);
SET (INSERT, CURRENT_BUFFER);
IF (vi$undo_start = 0) THEN
vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
ELSE
pos := MARK (NONE);
POSITION (vi$undo_start);
MOVE_HORIZONTAL (1);
vi$undo_start := MARK (NONE);
POSITION (pos);
ENDIF;
ELSE
POSITION (pos);
ENDIF;
IF (vi$show_mode) THEN
MESSAGE ("");
ENDIF;
RETURN;
ENDPROCEDURE
!
! Perform the 'R' command
!
PROCEDURE vi$_replace_str
LOCAL
replace,
max_mark,
start_pos,
spos,
pos,
max_col;
pos := MARK (NONE);
max_col := CURRENT_OFFSET;
start_pos := max_col;
POSITION (LINE_END);
max_mark := MARK(NONE);
vi$undo_end := MARK (NONE);
POSITION (pos);
vi$update (CURRENT_WINDOW);
replace := CURRENT_LINE;
spos := vi$get_undo_start;
vi$save_for_undo (CREATE_RANGE (pos, max_mark, NONE), VI$IN_LINE_MODE, 1);
vi$line_edit (max_col, start_pos, max_mark, replace);
IF (CURRENT_CHARACTER = "") THEN
MOVE_HORIZONTAL (1);
pos := MARK (NONE);
MOVE_HORIZONTAL (-1);
ELSE
pos := MARK (NONE);
ENDIF;
vi$undo_start := vi$set_undo_start (spos);
POSITION (pos);
ENDPROCEDURE;
!
! As in REAL vi, this procedure does not recognize a repeat count.
! A simple loop would make it possible to use the repeat count contained
! in "vi$active_count". A macro is used so that all of the crap for undo
! need not be placed here.
!
PROCEDURE vi$_change_case
LOCAL
pos;
vi$active_count := 0;
pos := INDEX (vi$_lower_chars, CURRENT_CHARACTER);
IF pos <> 0 THEN
vi$do_macro ("r"+SUBSTR (vi$_upper_chars, pos, 1)+"l", 0);
ELSE
pos := INDEX (vi$_upper_chars, CURRENT_CHARACTER);
IF pos <> 0 THEN
vi$do_macro ("r"+SUBSTR (vi$_lower_chars, pos, 1)+"l", 0);
ELSE
vi$kill_undo;
vi$undo_end := 0;
MOVE_HORIZONTAL (1);
ENDIF;
ENDIF;
ENDPROCEDURE;
!
!
!
PROCEDURE vi$init_action (olen)
LOCAL
nchar;
olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
IF (vi$select_pos = 0) THEN
nchar := vi$read_a_key;
IF (INDEX ("123456789", ASCII(nchar)) <> 0) THEN
vi$active_count := INDEX (vi$_numeric_chars, ASCII(nchar)) - 1;
LOOP
nchar := vi$read_a_key;
EXITIF (INDEX (vi$_numeric_chars, ASCII(nchar)) = 0);
vi$active_count := vi$active_count *
10 + (INDEX (vi$_numeric_chars, ASCII (nchar)) - 1);
ENDLOOP;
ENDIF;
ELSE
nchar := KEY_NAME (".");
ENDIF;
RETURN (nchar);
ENDPROCEDURE;
!
!
!
PROCEDURE vi$get_prog (nchar)
IF (vi$select_pos = 0) THEN
RETURN (LOOKUP_KEY (KEY_NAME (nchar), COMMENT, vi$move_keys));
ELSE
RETURN ("vi$get_select_pos");
ENDIF;
ENDPROCEDURE;
!
!
!
PROCEDURE vi$do_movement (prog, mtype)
vi$endpos := 0;
vi$new_endpos := 0;
vi$command_type := mtype;
EXECUTE (COMPILE ("vi$endpos := " + prog));
IF vi$new_endpos <> 0 THEN
vi$endpos := vi$new_endpos;
ENDIF;
ENDPROCEDURE;
!
! Perform the operations associated with the 'c' command.
!
PROCEDURE vi$_change
LOCAL
max_mark,
max_col,
start_col,
start_offset,
end_offset,
start_line,
end_line,
cha_range,
pos,
olen,
prog,
do_back,
nchar;
ON_ERROR;
vi$info ("Error occured during change, at line: "+STR(ERROR_LINE));
POSITION (vi$start_pos);
RETURN;
ENDON_ERROR;
vi$new_offset := 1;
nchar := vi$init_action (olen);
IF (nchar = KEY_NAME ('c')) THEN
vi$_big_s;
RETURN;
ENDIF;
! If the movement will be backwards, then the region must not include
! the current character.
do_back := vi$get_direction (nchar);
IF do_back THEN
vi$move_horizontal (-1);
vi$start_pos := MARK (NONE);
vi$move_horizontal (1);
ELSE
vi$start_pos := MARK (NONE);
ENDIF;
prog := vi$get_prog (nchar);
IF prog <> "" THEN
vi$do_movement (prog, VI$CHANGE_TYPE);
POSITION (vi$start_pos);
start_offset := CURRENT_OFFSET;
POSITION (LINE_BEGIN);
start_line := MARK (NONE);
POSITION (vi$start_pos);
IF (vi$endpos <> 0) THEN
POSITION (vi$endpos);
POSITION (LINE_BEGIN);
end_line := MARK (NONE);
POSITION (vi$endpos);
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
(NOT do_back) AND
(INDEX (vi$weird_moves, ASCII (nchar)) = 0) THEN
vi$move_horizontal (-1);
ENDIF;
end_offset := CURRENT_OFFSET + 1;
cha_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
IF (start_line <> end_line) THEN
IF (cha_range <> 0) THEN
POSITION (vi$start_pos);
vi$undo_start := vi$get_undo_start;
vi$save_for_undo (cha_range, vi$yank_mode, 0);
vi$type2buf (STR(vi$yank_mode), vi$temp_buf);
vi$cur_text := vi$cp2buf (cha_range, vi$temp_buf);
ERASE (cha_range);
IF (vi$while_not_esc = 0) THEN
vi$undo_end := 0;
ELSE
vi$undo_end := MARK (NONE);
vi$undo_start := vi$set_undo_start (vi$undo_start);
POSITION (vi$undo_end);
IF (CURRENT_CHARACTER = "") THEN
MOVE_HORIZONTAL (1);
ENDIF;
ENDIF;
ELSE
vi$info ("Internal error while changing!");
ENDIF;
ELSE
IF (cha_range <> 0) THEN
IF (start_offset < end_offset) THEN
max_col := end_offset;
MOVE_HORIZONTAL (1);
max_mark := MARK (NONE);
MOVE_HORIZONTAL (-1);
start_col := start_offset;
ELSE
POSITION (vi$start_pos);
MOVE_HORIZONTAL (1);
max_col := CURRENT_OFFSET;
max_mark := MARK (NONE);
POSITION (vi$start_pos);
start_col := end_offset - 1;
ENDIF;
cha_range := SUBSTR (vi$current_line, start_col + 1,
max_col - start_col);
vi$type2buf (STR (vi$yank_mode), vi$temp_buf);
vi$cur_text := vi$cp2buf (cha_range, vi$temp_buf);
vi$save_for_undo (cha_range, vi$yank_mode, 0);
SET (OVERSTRIKE, CURRENT_BUFFER);
COPY_TEXT ("$");
SET (INSERT, CURRENT_BUFFER);
IF (start_offset < end_offset) THEN
POSITION (vi$start_pos);
ELSE
POSITION (vi$endpos);
ENDIF;
vi$update (CURRENT_WINDOW);
vi$undo_start := vi$get_undo_start;
if (vi$line_edit (max_col, start_col, max_mark, 0) = 0) THEN
vi$undo_end := 0;
ELSE
vi$undo_end := MARK (NONE);
IF (CURRENT_CHARACTER = "") THEN
MOVE_HORIZONTAL (1);
ENDIF;
ENDIF;
pos := MARK (NONE);
vi$undo_start := vi$set_undo_start (vi$undo_start);
POSITION (pos);
ELSE
vi$info ("Internal error while changing!");
ENDIF;
ENDIF;
ELSE
vi$abort (0);
ENDIF;
ELSE
vi$abort (0);
ENDIF;
vi$check_length (olen);
ENDPROCEDURE;
!
! Decide which direction the movement will be based on whether or not
! the last movement was a t, T, f, F, or other backward movement.
!
PROCEDURE vi$get_direction (nchar)
LOCAL
do_back;
do_back := 0;
IF ((ASCII (nchar) = ",") AND ((vi$last_s_func = "vi$find_char") OR
(vi$last_s_func = "vi$to_char"))) OR
((ASCII (nchar) = ";") AND ((vi$last_s_func = "vi$back_find_char") OR
(vi$last_s_func = "vi$back_to_char"))) THEN
do_back := 1;
ENDIF;
IF (INDEX (vi$back_moves + vi$weird2_moves, ASCII(nchar)) <> 0) THEN
do_back := 1;
ENDIF;
IF (ASCII (nchar) = 'G') AND (vi$cur_line_no > vi$active_count) AND
(vi$active_count > 0) THEN
do_back := 1;
ENDIF;
RETURN (do_back);
ENDPROCEDURE;
!
! Given the fact that a select range is active, modify vi$start_pos
! to be the start of that range, and return the end of the select
! range.
!
PROCEDURE vi$get_select_pos
LOCAL
pos,
rng;
rng := SELECT_RANGE;
IF (rng <> 0) THEN
pos := MARK (NONE);
vi$select_pos := 0;
vi$start_pos := BEGINNING_OF (rng);
POSITION (END_OF (rng));
MOVE_HORIZONTAL (1);
MESSAGE ("");
RETURN (vi$retpos (pos));
ELSE
vi$select_pos := 0;
vi$info ("No region selected!");
ENDIF;
RETURN (0);
ENDPROCEDURE;
!
! Perform the operations associated with the 'S' command.
!
PROCEDURE vi$_big_s
LOCAL
max_mark,
start_pos,
max_col,
rng,
start,
tend,
pos;
POSITION (LINE_BEGIN);
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (-1);
vi$undo_start := MARK (NONE);
MOVE_HORIZONTAL (1);
ELSE
vi$undo_start := 0;
ENDIF;
IF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) THEN
vi$undo_end := 0;
ENDIF;
start := MARK (NONE);
MOVE_VERTICAL (vi$cur_active_count - 1);
IF (LENGTH (vi$current_line) > 0) THEN
POSITION (LINE_END);
MOVE_HORIZONTAL (-1);
ENDIF;
tend := MARK (NONE);
rng := CREATE_RANGE (start, tend, NONE);
POSITION (start);
vi$save_for_undo (rng, VI$IN_LINE_MODE, 1);
ERASE (rng);
max_col := CURRENT_OFFSET;
start_pos := max_col;
max_mark := MARK(NONE);
vi$update (CURRENT_WINDOW);
IF (vi$line_edit (max_col, start_pos, max_mark, 0) <> 0) THEN
vi$undo_end := MARK (NONE);
IF (CURRENT_CHARACTER = "") THEN
MOVE_HORIZONTAL (1);
ENDIF;
ELSE
vi$undo_end := 0;
ENDIF;
pos := MARK (NONE);
vi$undo_start := vi$set_undo_start (vi$undo_start);
POSITION (pos);
ENDPROCEDURE;
!
! This function performs the operations associated with the '"' command
! that allows one of the 26 named buffers, or one of the 10 delete
! buffers to be the target of a 'd', 'D', 'x', 'X', 'y', 'Y', 'p' or 'P'
! command.
!
PROCEDURE vi$select_buffer
LOCAL
numeric,
asc_action,
action,
prog,
buf_name,
nchar;
ON_ERROR;
RETURN;
ENDON_ERROR;
nchar := ASCII (vi$read_a_key);
action := vi$read_a_key;
asc_action := ASCII (action);
numeric := (INDEX (vi$_numeric_chars, asc_action) <> 0);
IF numeric THEN
vi$active_count := INDEX (vi$_numeric_chars, asc_action) - 1;
LOOP
action := vi$read_a_key;
asc_action := ASCII (action);
EXITIF (INDEX (vi$_numeric_chars, asc_action) = 0);
vi$active_count := (vi$active_count * 10) +
(INDEX (vi$_numeric_chars, asc_action) - 1);
ENDLOOP;
ENDIF;
IF (asc_action <> 'P') AND (asc_action <> 'p') AND (asc_action <> 'd') AND
(asc_action <> 'D') AND (asc_action <> 'y') AND (asc_action <> 'Y') AND
(asc_action <> 'x') AND (asc_action <> 'X') AND (NOT numeric) THEN
vi$info ("Unrecognized buffer action, ignoring: '"+asc_action+"'");
RETURN;
ENDIF;
IF (INDEX ("123456789", nchar) <> 0) THEN
IF (asc_action <> 'P') AND (asc_action <> 'p') THEN
RETURN;
ENDIF;
! Selected a deletion buffer.
buf_name := "vi$del_buf_"+nchar;
ELSE
IF (INDEX (vi$_letter_chars, nchar) <> 0) THEN
! Selected a named buffer.
IF (INDEX (vi$_upper_chars, nchar) <> 0) THEN
nchar := SUBSTR (vi$_lower_chars,
INDEX (vi$_upper_chars, nchar), 1);
vi$append_it := 1;
ENDIF;
buf_name := "vi$ins_buf_"+nchar;
! Only create a buffer if we are going to put something into it.
IF (asc_action <> 'P') AND (asc_action <> 'p') THEN
EXECUTE (COMPILE ('vi$get_ins_buf(' +
buf_name + ', "'+buf_name+'");'));
ELSE
vi$global_var := 0;
EXECUTE (COMPILE ("vi$global_var:="+buf_name));
IF (vi$global_var = 0) THEN
vi$info ("There is nothing in that buffer!");
RETURN;
ENDIF;
ENDIF;
ELSE
vi$info ("Invalid buffer!");
RETURN;
ENDIF;
ENDIF;
! We now have a buffer, and the next command key, so envoke the
! proper code.
vi$do_buf_act (asc_action, 'P', "vi$put_here (VI$HERE, "+buf_name+");");
vi$do_buf_act (asc_action, 'p', "vi$put_after ("+buf_name+");");
vi$do_buf_act (asc_action, 'd', "vi$_delete (0, "+buf_name+");");
vi$do_buf_act (asc_action, 'D',
"vi$_delete (KEY_NAME('$'), "+buf_name+");");
vi$do_buf_act (asc_action, 'x', "vi$_delete ('l', "+buf_name+");");
vi$do_buf_act (asc_action, 'X', "vi$_delete ('h', "+buf_name+");");
vi$do_buf_act (asc_action, 'y', "vi$_yank (0, "+buf_name+");");
vi$do_buf_act (asc_action, 'Y', "vi$_yank ('y', "+buf_name+");");
vi$do_buf_act (asc_action, 'Y', "vi$_yank (KEY_NAME('y'), "+buf_name+");");
ENDPROCEDURE;
!
! Perform action based on key typed and passed data
!
PROCEDURE vi$do_buf_act (act_type, look_for, what_to_do)
IF (act_type = look_for) THEN
EXECUTE (COMPILE (what_to_do));
ENDIF;
ENDPROCEDURE;
!
! Create a buffer named 'bname' providing that there is not already a
! buffer by that name.
!
PROCEDURE vi$get_ins_buf (buf, bname)
IF (buf = 0) THEN
buf := vi$init_buffer (bname, "");
ENDIF;
IF buf = 0 THEN
vi$info ("Error creating named buffer!");
ENDIF;
ENDPROCEDURE;
!
! Perform the delete command tied to the 'd' key.
!
PROCEDURE vi$_delete (opchar, dest_buf)
LOCAL
olen,
old_offset,
new_offset,
era_range,
opos,
prog,
do_back,
nchar;
ON_ERROR;
vi$info ("Error occured during delete, at line: "+STR(ERROR_LINE));
POSITION (vi$start_pos);
RETURN;
ENDON_ERROR;
vi$new_offset := 1;
nchar := opchar;
opos := MARK (NONE);
IF (nchar = 0) THEN
nchar := vi$init_action (olen);
ELSE
olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
ENDIF;
! If the movement will be backwards, then the region must not include
! the current character.
old_offset := -1;
new_offset := -1;
do_back := vi$get_direction (nchar);
IF do_back THEN
old_offset := CURRENT_OFFSET;
vi$move_horizontal (-1);
new_offset := CURRENT_OFFSET;
ENDIF;
vi$start_pos := MARK (NONE);
! For "dh" or "X" (a macro of "dh"), we must let vi$left do the movement.
IF (INDEX (vi$weird2_moves, ASCII(nchar)) <> 0) AND
(old_offset <> new_offset) THEN
MOVE_HORIZONTAL (1);
ENDIF;
prog := vi$get_prog (nchar);
IF prog <> "" THEN
vi$do_movement (prog, VI$DELETE_TYPE);
IF (vi$endpos <> 0) THEN
IF (do_back) AND (vi$yank_mode = VI$LINE_MODE) THEN
POSITION (vi$start_pos);
vi$move_vertical (1);
IF (LENGTH(vi$current_line) > 0) THEN
MOVE_HORIZONTAL (-1);
ENDIF;
vi$start_pos := MARK (NONE);
ENDIF;
POSITION (vi$endpos);
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
(NOT do_back) AND
(INDEX (vi$weird_moves, ASCII (nchar)) = 0) THEN
MOVE_HORIZONTAL (-1);
ENDIF;
era_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
IF (era_range <> 0) THEN
IF (GET_INFO (dest_buf, "TYPE") = INTEGER) THEN
vi$cur_text := vi$put2del_buf (vi$yank_mode, era_range);
ELSE
vi$type2buf (STR (vi$yank_mode), dest_buf);
vi$cur_text := vi$cp2buf (era_range, dest_buf);
ENDIF;
vi$undo_end := 0;
POSITION (BEGINNING_OF (era_range));
vi$save_for_undo (era_range, vi$yank_mode, 1);
vi$undo_start := vi$start_pos;
ERASE (era_range);
ELSE
vi$info ("Internal error while deleting!");
ENDIF;
POSITION (vi$start_pos);
ELSE
vi$abort (0);
POSITION (opos);
ENDIF;
ELSE
POSITION (opos);
vi$abort (0);
ENDIF;
vi$check_length (olen);
ENDPROCEDURE;
!
! This procedure checks a change in the size of the buffer, and reports
! the change if it is greater than the number set with ":set report"
!
PROCEDURE vi$check_length (olen)
LOCAL
nlen;
nlen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
IF (nlen - vi$report) >= olen THEN
vi$info (STR (nlen - olen) + " more lines!");
ELSE
IF (nlen + vi$report <= olen) THEN
vi$info (STR (olen - nlen) + " fewer lines!");
ENDIF;
ENDIF;
ENDPROCEDURE;
!
! Perform the yank command tied to the 'y' key.
!
PROCEDURE vi$_yank (opchar, dest_buf)
LOCAL
old_offset,
new_offset,
pos,
oline,
nline,
yank_range,
prog,
do_back,
nchar;
ON_ERROR;
vi$info ("Error occured during yank, at line: "+STR(ERROR_LINE));
POSITION (vi$start_pos);
RETURN;
ENDON_ERROR;
nchar := opchar;
pos := MARK (NONE);
IF nchar = 0 THEN
nchar := vi$init_action (oline);
ENDIF;
old_offset := -1;
new_offset := -1;
! If the movement will be backwards, then the region must not include
! the current character.
do_back := vi$get_direction (nchar);
IF do_back THEN
old_offset := CURRENT_OFFSET;
vi$move_horizontal (-1);
new_offset := CURRENT_OFFSET;
ENDIF;
vi$start_pos := MARK (NONE);
! For "yl" and similar moves, we must let vi$left to the movement.
IF (INDEX (vi$weird2_moves, ASCII(nchar)) <> 0) AND
(old_offset <> new_offset) THEN
MOVE_HORIZONTAL (1);
ENDIF;
prog := vi$get_prog (nchar);
IF prog <> "" THEN
vi$do_movement (prog, VI$YANK_TYPE);
oline := vi$cur_line_no;
IF (vi$endpos <> 0) THEN
POSITION (vi$endpos);
nline := vi$abs (vi$cur_line_no - oline);
IF (nline >= vi$report) THEN
vi$info (STR (nline) + " lines yanked");
ENDIF;
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
(NOT do_back) AND
(INDEX (vi$weird_moves, ASCII (nchar)) = 0) THEN
MOVE_HORIZONTAL (-1);
ENDIF;
yank_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
IF (yank_range <> 0) THEN
IF (GET_INFO (dest_buf, "TYPE") = INTEGER) THEN
vi$cur_text := vi$put2yank_buf (yank_range, vi$temp_buf);
ELSE
vi$cur_text := vi$put2yank_buf (yank_range, dest_buf);
ENDIF;
ELSE
vi$info ("Internal error while yanking!");
ENDIF;
ELSE
vi$abort (0);
ENDIF;
POSITION (pos);
ELSE
vi$abort (0);
ENDIF;
ENDPROCEDURE;
!
! Return the absolute value of the value passed.
!
PROCEDURE vi$abs (val)
IF val < 0 THEN
RETURN (-val);
ENDIF;
RETURN (val);
ENDPROCEDURE;
!
! Given a range of a buffer, or a string, place it into the "kill-ring"
! sliding the text back one slot that is already there.
!
PROCEDURE vi$put2del_buf (mode, string_parm)
LOCAL
local_str,
pos;
pos := MARK (NONE);
IF (mode = VI$LINE_MODE) THEN
! Slide each range back one slot, throwing away the last.
vi$mv2buf (vi$del_buf_8, vi$del_buf_9);
vi$mv2buf (vi$del_buf_7, vi$del_buf_8);
vi$mv2buf (vi$del_buf_6, vi$del_buf_7);
vi$mv2buf (vi$del_buf_5, vi$del_buf_6);
vi$mv2buf (vi$del_buf_4, vi$del_buf_5);
vi$mv2buf (vi$del_buf_3, vi$del_buf_4);
vi$mv2buf (vi$del_buf_2, vi$del_buf_3);
vi$mv2buf (vi$del_buf_1, vi$del_buf_2);
! Place the new text at the front.
vi$type2buf (STR(mode), vi$del_buf_1);
vi$cp2buf (string_parm, vi$del_buf_1);
ENDIF;
! Save the text so that a normal 'p' or 'P' command also works.
vi$type2buf (STR(mode), vi$temp_buf);
vi$cp2buf (string_parm, vi$temp_buf);
POSITION (pos);
RETURN (vi$temp_buf);
ENDPROCEDURE;
!
! Copy the text specified by source into the delete buffer given by
! dest. If dest is zero, the it will be set to the value of a newly
! created buffer.
!
PROCEDURE vi$cp2buf (source, dest)
LOCAL
pos;
pos := MARK (NONE);
IF (source <> 0) THEN
IF (dest = 0) THEN
dest := vi$init_buffer ("TEMP_BUF_"+str(vi$temp_buf_num), "");
vi$temp_buf_num := vi$temp_buf_num + 1;
ENDIF;
POSITION (dest);
COPY_TEXT (source);
ENDIF;
POSITION (pos);
RETURN (dest);
ENDPROCEDURE;
!
! vi$mv2buf is like vi$cp2buf except that vi$mv2buf erases the buffer before
! performing the copy.
!
PROCEDURE vi$mv2buf (source, dest)
LOCAL
pos;
pos := MARK (NONE);
IF (source <> 0) THEN
IF (dest = 0) THEN
dest := vi$init_buffer ("TEMP_BUF_"+str(vi$temp_buf_num), "");
vi$temp_buf_num := vi$temp_buf_num + 1;
ELSE
ERASE (dest);
ENDIF;
POSITION (dest);
COPY_TEXT (source);
ENDIF;
POSITION (pos);
ENDPROCEDURE;
!
! Given the string representation of either VI$LINE_MODE or VI$IN_LINE_MODE,
! place that text into the buffer given by dest.
!
PROCEDURE vi$type2buf (source, dest)
LOCAL
pos;
pos := MARK (NONE);
IF (source <> 0) THEN
IF (dest = 0) THEN
dest := vi$init_buffer ("TEMP_BUF_"+str(vi$temp_buf_num), "");
vi$temp_buf_num := vi$temp_buf_num + 1;
ELSE
ERASE (dest);
ENDIF;
POSITION (BEGINNING_OF (dest));
COPY_TEXT (source);
SPLIT_LINE;
ENDIF;
POSITION (pos);
ENDPROCEDURE;
!
! Save a piece of yanked text including the mode that it was yanked.
!
PROCEDURE vi$put2yank_buf (string_parm, dest_buf)
LOCAL
pos;
pos := MARK (NONE);
! Set type of text in buffer.
IF (vi$append_it = 0) THEN
vi$type2buf (STR (vi$yank_mode), dest_buf);
ELSE
! If empty buffer then put in type.
IF (GET_INFO (dest_buf, "RECORD_COUNT") < 2) THEN
vi$type2buf (STR (vi$yank_mode), dest_buf);
ENDIF;
vi$append_it := 0;
ENDIF;
vi$cp2buf (string_parm, dest_buf);
POSITION (pos);
RETURN (dest_buf);
ENDPROCEDURE;
!
! This is a debugging procedure used to view the contents of a buffer.
! It displays the buffer indicated by 'buf', and sets the status line
! of the window displayed to contain the text given by 'stat_line'.
!
PROCEDURE vi$show_buf (buf, stat_line)
LOCAL
this_key,
pos,
new_win;
IF (GET_INFO (buf, "TYPE") <> BUFFER) THEN
vi$info ("show_buf called with non_buffer, message: "+stat_line);
RETURN;
ENDIF;
pos := MARK (NONE);
new_win := CREATE_WINDOW (1, 23, ON);
MAP (new_win, buf);
POSITION (buf);
SET (STATUS_LINE, new_win, REVERSE, stat_line +
", BUFFER NAME: '"+GET_INFO (buf, "NAME")+"'");
vi$pos_in_middle (MARK (NONE));
UPDATE (new_win);
LOOP
vi$info ("Press RETURN to continue editing...");
this_key := READ_KEY;
EXITIF (this_key = RET_KEY);
IF (this_key = CTRL_D_KEY) OR
(this_key = CTRL_U_KEY) OR
(this_key = CTRL_F_KEY) OR
(this_key = CTRL_B_KEY) OR
(this_key = KEY_NAME ('h')) OR
(this_key = KEY_NAME ('j')) OR
(this_key = KEY_NAME ('k')) OR
(this_key = KEY_NAME ('l')) THEN
EXECUTE (LOOKUP_KEY (this_key, PROGRAM, vi$cmd_keys));
UPDATE (new_win);
ENDIF;
ENDLOOP;
UNMAP (new_win);
DELETE (new_win);
POSITION (pos);
UPDATE (CURRENT_WINDOW);
ENDPROCEDURE;
!
! This procedure moves the cursor down the number of lines indicated by
! vi$active count. The parameter passed is used by delete and yank
! operations to differentiate them from normal cursor movement.
!
PROCEDURE vi$downline (adj)
LOCAL
pos,
tabstops,
cur_off,
offset;
! Ignore error messages
ON_ERROR
vi$active_count := 0;
POSITION (pos);
RETURN (0);
ENDON_ERROR;
pos := MARK (NONE);
POSITION (LINE_BEGIN);
vi$start_pos := MARK (NONE);
POSITION (pos);
tabstops := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");
IF (GET_INFO (tabstops, "TYPE") <> STRING) THEN
offset := CURRENT_OFFSET;
cur_off := GET_INFO (SCREEN, "CURRENT_COLUMN") - 1;
MOVE_VERTICAL (vi$cur_active_count + adj);
POSITION (LINE_BEGIN);
IF (vi$new_offset = 1) THEN
vi$max_offset := cur_off;
vi$new_offset := 0;
ELSE
IF (cur_off < vi$max_offset) THEN
cur_off := vi$max_offset;
ENDIF;
ENDIF;
! Save the beginning of the line as the new beginning.
vi$new_endpos := MARK (NONE);
IF (vi$new_endpos = END_OF (CURRENT_BUFFER)) THEN
POSITION (pos);
RETURN (0);
ENDIF;
vi$to_offset (vi$current_line, cur_off, tabstops);
ELSE
MOVE_VERTICAL (vi$cur_active_count + adj);
ENDIF;
vi$yank_mode := VI$LINE_MODE;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! Move left one location. Do not wrap at edge of the screen.
!
PROCEDURE vi$left
LOCAL
pos;
! Ignore error messages
ON_ERROR
vi$active_count := 0;
POSITION (pos);
RETURN (0);
ENDON_ERROR;
pos := MARK (NONE);
vi$new_offset := 1;
IF (CURRENT_OFFSET < vi$active_count) OR (CURRENT_OFFSET = 0) THEN
vi$active_count := 0;
RETURN (0);
ENDIF;
MOVE_HORIZONTAL (-vi$cur_active_count);
vi$yank_mode := VI$IN_LINE_MODE;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! Move right one location. Stop at the end of the line, but, do not
! wrap at edge of the screen.
!
PROCEDURE vi$right
LOCAL
pos,
line,
offset;
! Ignore error messages
ON_ERROR
vi$active_count := 0;
POSITION (pos);
RETURN (0);
ENDON_ERROR
pos := MARK (NONE);
line := CURRENT_LINE;
offset := CURRENT_OFFSET;
! This makes it possible to use the "s" command at the end of the line.
IF (vi$command_type <> VI$OTHER_TYPE) THEN
offset := offset - 1;
IF (LENGTH (CURRENT_LINE) = 0) THEN
COPY_TEXT (" ");
MOVE_HORIZONTAL (-1);
vi$start_pos := MARK (NONE);
ENDIF;
ENDIF;
IF (vi$active_count < (LENGTH (line) - offset -
(vi$command_type = VI$OTHER_TYPE))) THEN
MOVE_HORIZONTAL (vi$cur_active_count);
ELSE
vi$active_count := 0;
RETURN (0);
ENDIF;
vi$new_offset := 1;
vi$yank_mode := VI$IN_LINE_MODE;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! Move up one row, staying in the same column. Scroll if necessary.
!
PROCEDURE vi$upline
LOCAL
pos,
tabstops,
offset,
cur_off;
! Ignore error messages
ON_ERROR
vi$active_count := 0;
POSITION (pos);
RETURN (0);
ENDON_ERROR;
pos := MARK (NONE);
tabstops := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");
POSITION (LINE_END);
vi$new_endpos := MARK(NONE);
POSITION (pos);
! We must understand it (i.e. it must be an integer) inorder to process
! the tabs properly.
IF (GET_INFO (tabstops, "TYPE") <> STRING) THEN
offset := CURRENT_OFFSET;
cur_off := GET_INFO (SCREEN, "CURRENT_COLUMN") - 1;
MOVE_VERTICAL(-vi$cur_active_count);
POSITION (LINE_BEGIN);
IF vi$new_offset = 1 THEN
vi$max_offset := cur_off;
vi$new_offset := 0;
ENDIF;
IF (cur_off < vi$max_offset) THEN
cur_off := vi$max_offset;
ENDIF;
! Save the beginning of the line as the new beginning.
vi$start_pos := MARK (NONE);
vi$to_offset (CURRENT_LINE, cur_off, tabstops);
ELSE
MOVE_VERTICAL (-vi$cur_active_count);
ENDIF;
vi$yank_mode := VI$LINE_MODE;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! Move the cursor to the offset given by 'offset' counting tabs as expanded
! spaces.
!
PROCEDURE vi$to_offset (line, offset, tabstops)
LOCAL
cur_ch,
col,
diff,
len,
tab,
idx;
idx := 1;
col := 0;
len := LENGTH (line);
tab := ASCII (9);
LOOP
EXITIF (len < idx) OR (col >= offset);
IF (SUBSTR (line, idx, 1) = tab) THEN
diff := (((col+tabstops)/tabstops)*tabstops)-col;
ELSE
diff := 1;
ENDIF;
col := col + diff;
idx := idx + 1;
ENDLOOP;
! Move N characters to the right.
MOVE_HORIZONTAL (idx - 1);
ENDPROCEDURE;
!
! Search for a text string. This procedure is activated by typing
! either a '/' or a '?'.
!
PROCEDURE vi$search (direction)
LOCAL
where,
i,
pos,
ch,
sstr,
cnt,
add_spec,
prompt;
pos := MARK (NONE);
IF (direction > 0) THEN
prompt := "/";
ELSE
prompt := "?";
ENDIF;
IF (vi$read_a_line (prompt, sstr) = 0) THEN
RETURN (0);
ENDIF;
i := 1;
LOOP
EXITIF (i > LENGTH (sstr));
ch := SUBSTR (sstr, i, 1);
IF (ch = "\") THEN
i := i + 1;
ELSE
EXITIF (ch = prompt);
ENDIF;
i := i + 1;
ENDLOOP;
! If the search string is followed by the delimiter, then allow an
! additional line offset specification.
add_spec := 0;
IF (ch = prompt) THEN
add_spec := SUBSTR (sstr, i+1, 255);
sstr := SUBSTR (sstr, 1, i-1);
ENDIF;
IF (direction > 0) THEN
SET (FORWARD, CURRENT_BUFFER);
vi$last_search_dir := 1;
vi$move_horizontal (1);
ELSE
SET (REVERSE, CURRENT_BUFFER);
vi$last_search_dir := -1;
ENDIF;
IF sstr <> "" THEN
vi$search_string := sstr;
ELSE
IF vi$search_string = 0 THEN
vi$info ("No previous string to search for!");
POSITION (pos);
RETURN (0);
ENDIF;
ENDIF;
! Search for the nth occurance.
cnt := vi$cur_active_count;
LOOP
where := vi$find_str (vi$search_string, 0, 0);
EXITIF (where = 0);
POSITION (BEGINNING_OF (where));
IF (CURRENT_DIRECTION = FORWARD) THEN
MOVE_HORIZONTAL (1);
ELSE
MOVE_HORIZONTAL (-1);
ENDIF;
cnt := cnt - 1;
EXITIF cnt = 0;
ENDLOOP;
! Check to see that we found one.
IF (where = 0) THEN
vi$info ("String not found");
ELSE
! Check for a relative line number after the search string.
IF add_spec <> 0 THEN
POSITION (where);
IF add_spec = "-" THEN
add_spec := "-1";
ELSE
IF (SUBSTR (add_spec, 1, 1) = "+") THEN
IF (add_spec = "+") THEN
add_spec := "1";
ENDIF;
ELSE
add_spec := SUBSTR (add_spec, 2, 255);
ENDIF;
ENDIF;
i := INT (add_spec);
MOVE_VERTICAL (i);
vi$_bol (0);
where := MARK (NONE);
ELSE
POSITION (BEGINNING_OF (where));
bpos := MARK (NONE);
POSITION (END_OF (where));
vi$find_rng := CREATE_RANGE (bpos, MARK(NONE), BOLD);
ENDIF;
ENDIF;
POSITION (pos);
! On success then return the position we moved to.
RETURN (where);
ENDPROCEDURE;
!
! Search for the next occurence of the previously searched for string.
! The procedure is actived by typing an 'n' or 'N' keystroke.
!
PROCEDURE vi$search_next (direction)
LOCAL
prompt,
where,
pos,
cnt,
sstr;
pos := MARK (NONE);
IF vi$search_string = 0 THEN
vi$info ("No previous string to search for!");
POSITION (pos);
RETURN (0);
ENDIF;
IF (direction > 0) THEN
prompt := "/" + vi$search_string;
SET (FORWARD, CURRENT_BUFFER);
IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (1);
$$EOD$$
More information about the Comp.sources.misc
mailing list