gregg@a.cs.okstate.edu@mandrill.CWRU.Edu (Gregg Wonderly) (10/13/87)
$ WRITE SYS$OUTPUT "Creating ""VI.6"""
$ CREATE VI.6
$ DECK/DOLLARS=$$EOD$$
ENDIF;
ELSE
regular := 1;
ENDIF;
IF (regular) THEN
new_pat := new_pat + cur_pat;
ELSE
IF new_pat = "" THEN
new_pat := cur_pat;
ELSE
new_pat := new_pat + "&" + cur_pat;
ENDIF;
ENDIF;
pos := pos + 1;
ENDLOOP;
RETURN (new_pat);
ENDPROCEDURE;
!
!
! TPU pattern generator. Generates a pattern string from the passed
! RE string. The function is used when :set magic is in effect.
!
PROCEDURE vi$re_pattern_gen (pat)
LOCAL
first, ! First pattern to be done
part_pat,
chno,
startchar,
haveany,
regular,
tstr,
endchar,
pat_str,
str_pat,
cur_pat, ! The current pattern to be extracted
cur_char, ! The current character in the regular
! expression being examined
new_pat, ! The output pattern
in_ws,
pos; ! The position within the regular
! expression string that we are examining
! currently
vi$in_ws := 0;
IF ((INDEX (pat, "$") <> 0) OR (INDEX (pat, "[") <> 0) OR
(INDEX (pat, "^") <> 0) OR (INDEX (pat, ".") <> 0) OR
(INDEX (pat, "*") <> 0) OR (INDEX (pat, "\") <> 0) OR
(INDEX (pat, '"') <> 0)) THEN
new_pat := "";
ELSE
new_pat := '"'+pat+'"';
RETURN (new_pat);
ENDIF;
in_ws := 0;
pos := 1;
IF SUBSTR (pat, pos, 1) = "^" THEN
new_pat := "line_begin";
pos := pos + 1;
ENDIF;
LOOP
EXITIF (pos > LENGTH (pat));
regular := 0;
cur_pat := "";
cur_char := substr (pat, pos, 1);
pat_str := "";
IF (cur_char = "$") THEN
IF (pos+1 >= LENGTH (pat)) THEN
cur_pat := "line_end";
ELSE
vi$message ("$ found before end of string");
RETURN (0);
ENDIF;
ELSE
IF cur_char = "[" THEN
pos := pos + 1;
IF SUBSTR (pat, pos, 1) = "^" THEN
pos := pos + 1;
part_pat := "notany('";
ELSE
part_pat := "any('";
ENDIF;
LOOP
EXITIF pos > LENGTH (pat);
EXITIF SUBSTR (pat, pos, 1) = "]";
IF SUBSTR (pat, pos, 1) = "\" THEN
pos := pos + 1;
IF pos > LENGTH (pat) THEN
vi$message ("Missing character after \");
RETURN ("");
ENDIF;
ENDIF;
startchar := SUBSTR (pat, pos, 1);
pat_str := pat_str + startchar;
IF startchar = "'" THEN
pat_str := pat_str + "'";
ENDIF;
IF (SUBSTR (pat, pos+1, 1) = '-') THEN
pos := pos + 2;
IF (pos >= LENGTH (pat)) THEN
vi$message ("Missing character after '-'");
RETURN ("");
ENDIF;
endchar := SUBSTR (pat, pos, 1);
chno := 1;
LOOP
EXITIF (ASCII(chno) = startchar);
chno := chno + 1;
ENDLOOP;
LOOP
chno := chno + 1;
IF (chno > 255) THEN
vi$message (
"Invalid character sequence for '-'");
RETURN ("");
ENDIF;
EXITIF (ASCII (chno-1) = endchar);
pat_str := pat_str + ASCII (chno);
IF ASCII (chno) = "'" THEN
pat_str := pat_str + "'";
ENDIF;
ENDLOOP;
ENDIF;
pos := pos + 1;
ENDLOOP;
IF pat_str = "" THEN
vi$message ("No text found between []");
RETURN ("");
ENDIF;
IF (SUBSTR (pat, pos+1, 1) = "*") THEN
IF (part_pat = "notany('") THEN
cur_pat := cur_pat + "(scan('"+pat_str+"')|"""")";
ELSE
cur_pat := cur_pat + "(span('"+pat_str+"')|"""")";
ENDIF;
pos := pos + 1;
ELSE
cur_pat := part_pat + pat_str + "')";
ENDIF;
ELSE
tstr := '"';
haveany := 0;
regular := 1;
LOOP
cur_char := SUBSTR (pat, pos, 1);
EXITIF (cur_char = "^") OR (cur_char = "[") OR
(cur_char = "$");
EXITIF (pos > LENGTH (pat));
IF cur_char = "\" THEN
pos := pos + 1;
startchar := SUBSTR (pat, pos, 1);
IF (startchar = "<") THEN
in_ws := 1;
vi$in_ws := 1;
tstr := tstr + '"&(line_begin | any (vi$_ws))&"';
ELSE
IF (startchar = ">") THEN
in_ws := 0;
tstr := tstr + '"&(line_end | any (vi$_ws))&"';
ELSE
tstr := tstr + startchar;
ENDIF;
ENDIF;
ELSE
IF (cur_char = ".") THEN
cur_char := "longer_than_1";
ENDIF;
IF (SUBSTR (pat, pos+1, 1) = '*') THEN
pos := pos + 1;
IF (LENGTH (cur_char) > 1) THEN
cur_pat := "''&(span(vi$pch)|'')";
ELSE
cur_pat := "(span('"+cur_char+"')|"""")";
ENDIF;
tstr := tstr+'"'+"&"+cur_pat+"&"+'"';
haveany := 0;
ELSE
IF (LENGTH (cur_char) > 1) THEN
IF (haveany) THEN
tstr := tstr +'"'+"&"+"arb(1)"+"&"+'"';
haveany := 0;
ELSE
IF (LENGTH (tstr)>0) and (tstr <> '"') THEN
tstr := tstr +'"'+"&"+"arb(1)"+"&"+'"';
ELSE
tstr := "arb(1)"+"&"+'"';
ENDIF
ENDIF;
ELSE
IF (cur_char = """") THEN
tstr := tstr + '""';
haveany := haveany + 2;
ELSE
tstr := tstr + cur_char;
haveany := haveany + 1;
ENDIF;
ENDIF;
ENDIF;
ENDIF;
pos := pos + 1;
ENDLOOP;
cur_pat := tstr + '"';
pos := pos - 1;
ENDIF;
ENDIF;
IF (regular) THEN
IF new_pat = "" THEN
new_pat := cur_pat;
ELSE
IF (LENGTH (tstr) > 1) THEN
new_pat := new_pat + "&" + cur_pat;
ENDIF;
ENDIF;
ELSE
IF new_pat = "" THEN
new_pat := cur_pat;
ELSE
new_pat := new_pat + "&" + cur_pat;
ENDIF;
ENDIF;
pos := pos + 1;
ENDLOOP;
IF (in_ws) THEN
MESSAGE ("Missing \> in pattern!");
RETURN (0);
ENDIF;
RETURN (new_pat);
ENDPROCEDURE;
!
! Match brackets when '%' is typed.
!
PROCEDURE vi$_match_brackets
vi$position (vi$match_brackets, 1);
ENDPROCEDURE;
!
! Perform the actual match bracket operation.
!
PROCEDURE vi$match_brackets
LOCAL
newpos,
ind_pos,
found,
cur_ch,
cur_dir,
pos;
ON_ERROR
IF ERROR = TPU$_CONTROLC THEN
vi$beep;
vi$pasthru_on;
RETURN (0);
ENDIF;
ENDON_ERROR;
found := 1;
vi$message ("");
pos := MARK (NONE);
cur_ch := CURRENT_CHARACTER;
ind_pos := INDEX (vi$bracket_chars, cur_ch);
IF (ind_pos = 0) THEN
newpos := SEARCH (ANCHOR & SCAN (")") & ARB (1), FORWARD, EXACT);
found := 0;
IF newpos <> 0 THEN
found := 1;
IF vi$in_show_match = 0 THEN
vi$old_place := pos;
ENDIF;
POSITION (END_OF (newpos));
RETURN (vi$retpos (pos));
ELSE
POSITION (pos);
RETURN (0);
ENDIF;
ENDIF;
IF ((ind_pos/2)*2 <> ind_pos) THEN
cur_dir := FORWARD;
ELSE
cur_dir := REVERSE;
ENDIF;
SET (TIMER, ON, "Searching...");
newpos := vi$do_match (CURRENT_CHARACTER, cur_dir, 0);
SET (TIMER, OFF);
IF (GET_INFO (newpos, "TYPE") = MARKER) THEN
RETURN (vi$retpos (pos));
ELSE
IF (newpos = 0) AND NOT (vi$in_show_match) THEN
vi$message ("No matching bracket");
ENDIF;
POSITION (pos);
ENDIF;
RETURN (0);
ENDPROCEDURE;
!
!
! This procedure knows how to traverse nested brackets to find the matching
! bracket. It takes the character that the cursor is positioned on, and
! finds the matching one. It recognizes '{}', '[]', '()' pairs.
!
PROCEDURE vi$do_match (bracket, cur_dir, level)
LOCAL
dgrp,
dest_char,
sel_reg,
ind_pos,
next_pos,
possibles,
cur_ch;
ON_ERROR
RETURN (0);
ENDON_ERROR;
IF level > 30 THEN
vi$message ("Too many nested levels");
RETURN (-1);
ENDIF;
! Identify the desired search direction based on the character.
ind_pos := INDEX (vi$bracket_chars, bracket);
dest_char := SUBSTR ("}{)(][", ind_pos, 1);
IF cur_dir = FORWARD THEN
MOVE_HORIZONTAL (1);
ENDIF;
dgrp := bracket + dest_char;
LOOP
sel_reg := SEARCH (ANY (dgrp), cur_dir, EXACT);
IF sel_reg = 0 THEN
RETURN (0);
ENDIF;
POSITION (BEGINNING_OF (sel_reg));
IF (CURRENT_CHARACTER = dest_char) THEN
RETURN (MARK (NONE));
ELSE
IF (((INDEX ("([{", CURRENT_CHARACTER) <> 0) AND
(cur_dir = FORWARD)) OR
((INDEX (")}]", CURRENT_CHARACTER) <> 0) AND
(cur_dir = REVERSE))) THEN
IF (INDEX (vi$bracket_chars, CURRENT_CHARACTER)-1)/2 <=
(INDEX (vi$bracket_chars, dest_char)-1)/2 THEN
next_pos := vi$do_match (CURRENT_CHARACTER,
cur_dir, level+1)
;
IF (next_pos <> 0) AND (next_pos <> -1) THEN
POSITION (next_pos);
ELSE
RETURN (next_pos);
ENDIF;
ENDIF;
ELSE
IF (INDEX (vi$bracket_chars, CURRENT_CHARACTER) = 0) THEN
vi$message ("Unknown bracket character: '"+
CURRENT_CHARACTER+"'");
RETURN (-1);
ENDIF;
ENDIF;
IF cur_dir = FORWARD THEN
MOVE_HORIZONTAL (1);
ENDIF;
ENDIF;
ENDLOOP;
ENDPROCEDURE;
!
! Move to the top line of the window when 'H' is pressed.
!
PROCEDURE home
POSITION (vi$to_home);
ENDPROCEDURE;
!
! Perform the actual movement for the 'H' command and return the marker.
!
PROCEDURE vi$to_home
LOCAL
pos;
ON_ERROR
! Ignore attempt to move beyond end of buffer errors.
ENDON_ERROR;
pos := MARK (NONE);
MOVE_VERTICAL ( GET_INFO (CURRENT_WINDOW, "VISIBLE_TOP") -
GET_INFO (CURRENT_WINDOW, "CURRENT_ROW"));
vi$yank_mode := VI$LINE_MODE;
RETURN (vi$retpos(pos));
ENDPROCEDURE
!
! Position the cursor into the middle of the current window when 'M' is
! pressed.
!
PROCEDURE vi$middle
POSITION (vi$to_middle);
ENDPROCEDURE;
!
! Perform the actual movement of the 'M' command.
!
PROCEDURE vi$to_middle
LOCAL
len,
cur,
top,
pos;
ON_ERROR
! Ignore attempt to move beyond end of buffer errors.
ENDON_ERROR;
pos := MARK (NONE);
len := GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH");
cur := GET_INFO (CURRENT_WINDOW, "CURRENT_ROW");
top := GET_INFO (CURRENT_WINDOW, "VISIBLE_TOP");
MOVE_VERTICAL (((len-top+1)/2) - (cur - top + 1));
vi$yank_mode := VI$LINE_MODE;
RETURN (vi$retpos(pos));
ENDPROCEDURE;
!
! Move the the last line of the current window when 'L' is pressed.
!
PROCEDURE vi$last
POSITION (vi$to_last);
ENDPROCEDURE;
!
! Perform the actual movement associated with the 'L' command.
!
PROCEDURE vi$to_last
LOCAL
pos;
ON_ERROR
! Ignore attempt to move beyond end of buffer errors.
ENDON_ERROR;
pos := MARK (NONE);
MOVE_VERTICAL ( GET_INFO (CURRENT_WINDOW, "VISIBLE_BOTTOM") -
GET_INFO (CURRENT_WINDOW, "CURRENT_ROW"));
vi$yank_mode := VI$LINE_MODE;
RETURN (vi$retpos (pos));
ENDPROCEDURE
!
! Move to the end of the current line when '$' is pressed.
!
PROCEDURE vi$_eol
POSITION (vi$eol);
ENDPROCEDURE;
!
! Perform the actual movement associated with the '$' command.
!
PROCEDURE vi$eol
LOCAL
pos;
ON_ERROR
RETURN (pos);
ENDON_ERROR;
pos := MARK (NONE);
MOVE_HORIZONTAL (-CURRENT_OFFSET);
MOVE_HORIZONTAL (LENGTH (vi$current_line));
vi$check_rmarg;
vi$yank_mode := VI$IN_LINE_MODE;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! Move the first non-blank character of the line when '^' is typed.
!
PROCEDURE vi$_bol
vi$position (vi$first_no_space, 0);
ENDPROCEDURE;
!
! Move the beginning of the line when '0' is typed.
!
PROCEDURE vi$fol
LOCAL
pos;
pos := MARK (NONE);
MOVE_HORIZONTAL (-CURRENT_OFFSET);
vi$yank_mode := VI$IN_LINE_MODE;
vi$new_offset := 1;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! Move the the location searched for.
!
PROCEDURE vi$_search (direction)
LOCAL
pos;
pos := vi$search(direction);
vi$position (pos, 1);
IF (pos <> 0) THEN
vi$pos_in_middle (MARK (NONE));
ENDIF;
ENDPROCEDURE;
!
! Move to the next location of the string previously searched for.
!
PROCEDURE vi$_search_next (direction)
LOCAL
pos;
pos := vi$search_next(direction);
vi$position (pos, 1);
IF (pos <> 0) THEN
vi$pos_in_middle (MARK (NONE));
ENDIF;
ENDPROCEDURE;
!
! Repeat the last 't' or 'f' command backwards.
!
PROCEDURE vi$_repeat_torf_back
vi$position (vi$repeat_torf_back, 0);
ENDPROCEDURE
!
! Repeat the last 't' or 'f' command.
!
PROCEDURE vi$_repeat_torf
vi$position (vi$repeat_torf, 0);
ENDPROCEDURE
!
! Return the location found by repeating the last 't', 'f', 'T' or 'F'
! command backwards.
!
PROCEDURE vi$repeat_torf_back
LOCAL
old_func,
back_func;
IF vi$last_s_func = 0 THEN
RETURN (0);
ENDIF;
old_func := vi$last_s_func;
IF (vi$last_s_func = "vi$back_find_char") THEN
back_func := "vi$find_char";
ENDIF;
IF (vi$last_s_func = "vi$find_char") THEN
back_func := "vi$back_find_char";
ENDIF;
IF (vi$last_s_func = "vi$back_to_char") THEN
back_func := "vi$to_char";
ENDIF;
IF (vi$last_s_func = "vi$to_char") THEN
back_func := "vi$back_to_char";
ENDIF;
vi$global_var := 0;
EXECUTE (COMPILE (
"vi$global_var := " + back_func + "('"+vi$last_s_char + "')"));
vi$last_s_func := old_func;
RETURN (vi$global_var);
ENDPROCEDURE
!
! Return the location found by repeating the last 't', 'f', 'T' or 'F'
! command.
!
PROCEDURE vi$repeat_torf
IF vi$last_s_func = 0 THEN
RETURN (0);
ENDIF;
vi$global_var := 0;
EXECUTE (COMPILE (
"vi$global_var := " + vi$last_s_func + "('"+vi$last_s_char + "')"));
RETURN (vi$global_var);
ENDPROCEDURE
!
! Return the value of a positive integer that is represented as a string.
! If the string is not a valid integer, then -1 is retured.
!
PROCEDURE vi$number_from_string (str_num)
ON_ERROR
RETURN (-1);
ENDON_ERROR;
RETURN (INT (str_num));
ENDPROCEDURE;
!
! Move to the line indicated by 'line_no', and return the marker that
! indicates the beginning of that line.
!
PROCEDURE vi$mark_line (line_no)
LOCAL
pos;
ON_ERROR
POSITION (pos);
RETURN (0);
ENDON_ERROR;
pos := MARK (NONE);
POSITION (BEGINNING_OF (CURRENT_BUFFER));
MOVE_VERTICAL (line_no - 1);
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! Perform an EX mode command after a ':' is typed.
!
PROCEDURE vi$ex_mode
LOCAL
cmd_str;
IF (vi$read_a_line (":", cmd_str) <> 0) and (cmd_str <> "") THEN
IF (vi$do_cmd_line (cmd_str) = 0) THEN
vi$message ("");
ENDIF;
ENDIF;
ENDPROCEDURE;
!
!
!
PROCEDURE vi$read_a_line (prompt, cmd_str)
LOCAL
cmd_idx,
addch,
ch,
did_ctl_v,
win,
pos;
win := CURRENT_WINDOW;
pos := MARK (NONE);
POSITION (END_OF (command_buffer));
MAP (command_window, command_buffer);
COPY_TEXT (prompt);
SET (OVERSTRIKE, CURRENT_BUFFER);
cmd_str := "";
cmd_idx := 0;
LOOP
vi$update (CURRENT_WINDOW);
ch := vi$read_a_key;
did_ctl_v := 0;
IF ch = CTRL_V_KEY THEN
COPY_TEXT ("^");
did_ctl_v := 1;
MOVE_HORIZONTAL (-1);
vi$update (CURRENT_WINDOW);
ch := vi$read_a_key;
ERASE_CHARACTER (1);
ENDIF;
EXITIF ((ch = RET_KEY) OR (ch = F11)) AND (did_ctl_v = 0);
IF (ch = RET_KEY) THEN ch := CTRL_M_KEY; ENDIF;
IF (ch = F12) THEN ch := CTRL_H_KEY; ENDIF;
IF (ch = F11) THEN ch := KEY_NAME (ASCII (27)); ENDIF;
IF ((ch = DEL_KEY) OR (ch = CTRL_H_KEY)) AND (did_ctl_v = 0) THEN
IF cmd_idx = 0 THEN
UNMAP (command_window);
UNMAP (message_window);
MAP (message_window, message_buffer);
POSITION (win);
POSITION (pos);
RETURN (0);
ENDIF;
ch := SUBSTR (cmd_str, cmd_idx, 1);
cmd_idx := cmd_idx - 1;
IF (INDEX (vi$_ctl_chars, ch) <> 0) THEN
MOVE_HORIZONTAL (-2);
ELSE
MOVE_HORIZONTAL (-1);
ENDIF;
cmd_str := SUBSTR (cmd_str, 1, cmd_idx);
ELSE
IF (ch <= KEY_NAME (ASCII (31))) AND (ch >= CTRL_A_KEY) THEN
IF ch = TAB_KEY THEN
addch := 9;
COPY_TEXT (ASCII(addch));
ELSE
addch := ((ch - CTRL_A_KEY) / 256) + 1;
COPY_TEXT ("^");
COPY_TEXT (ASCII (addch + 64));
ENDIF;
cmd_str := cmd_str + ASCII (addch);
cmd_idx := cmd_idx + 1;
IF ch = 27 THEN ch := F11; ENDIF;
ELSE
IF (ch = UP) THEN
vi$next_in_cmd (cmd_str, cmd_idx, prompt, -1);
ELSE
IF (ch = DOWN) THEN
vi$next_in_cmd (cmd_str, cmd_idx, prompt, 1);
ELSE
COPY_TEXT (ASCII(ch));
cmd_str := cmd_str + ASCII (ch);
cmd_idx := cmd_idx + 1;
ENDIF;
ENDIF;
ENDIF;
ENDIF;
ENDLOOP;
ERASE_CHARACTER (LENGTH (CURRENT_LINE) - CURRENT_OFFSET);
POSITION (END_OF (command_buffer));
LOOP
MOVE_VERTICAL (-1);
EXITIF (CURRENT_LINE <> prompt);
ERASE_LINE;
ENDLOOP;
IF (CURRENT_LINE <> prompt + cmd_str) THEN
MOVE_VERTICAL (1);
COPY_TEXT (prompt + cmd_str);
ENDIF;
UNMAP (command_window);
UNMAP (message_window);
MAP (message_window, message_buffer);
POSITION (win);
POSITION (pos);
RETURN (1);
ENDPROCEDURE;
!
! This procedure looks from the next occurence of 'prompt' at the
! beginning of the line, in the direction dir (1 or -1). If prompt
! is found, then cmd_str is set to the contents of that line, minus
! the text of the prompt, and cmd_idx is set to the length of cmd_str.
! The cursor is left positioned at the end of the line found, or if
! none is found, it is not moved.
!
PROCEDURE vi$next_in_cmd (cmd_str, cmd_idx, prompt, dir)
LOCAL
pos,
len;
ON_ERROR
POSITION (pos);
RETURN;
ENDON_ERROR;
pos := MARK (NONE);
len := LENGTH (prompt);
MOVE_HORIZONTAL (-CURRENT_OFFSET);
LOOP
EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND (dir = -1);
EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER)) AND (dir = 1);
MOVE_VERTICAL (DIR);
IF SUBSTR (CURRENT_LINE, 1, len) = prompt THEN
cmd_str := SUBSTR (CURRENT_LINE, len+1,
LENGTH (CURRENT_LINE) - len + 1);
cmd_idx := LENGTH (cmd_str);
MOVE_HORIZONTAL (LENGTH (CURRENT_LINE));
RETURN;
ENDIF;
ENDLOOP;
POSITION (pos);
ENDPROCEDURE;
!
! Perform a whole series of command separated by '|'s.
!
PROCEDURE vi$do_cmd_line (cmd)
LOCAL
ch,
retval,
idx,
strg;
idx := 1;
strg := "";
LOOP
EXITIF (idx > LENGTH (cmd));
ch := SUBSTR (cmd, idx, 1);
IF (ch = "|") THEN
retval := vi$do_command (strg);
IF (retval > 1) THEN
RETURN (retval);
ELSE
IF (retval = 0) THEN
MESSAGE ("");
ENDIF;
ENDIF;
strg := 0;
ELSE
IF (ch = "\") THEN
idx := idx + 1;
IF (SUBSTR (cmd, idx, 1) = "|") THEN
strg := strg + "|";
ELSE
strg := strg + "\" + SUBSTR (cmd, idx, 1);
ENDIF;
ELSE
strg := strg + ch;
ENDIF;
ENDIF;
idx := idx + 1;
ENDLOOP;
IF (strg <> 0) THEN
IF (vi$do_command (strg) <> 0) THEN
RETURN (1);
ELSE
MESSAGE ("");
ENDIF;
ENDIF;
RETURN (0);
ENDPROCEDURE;
!
! Perform an EX (not all are implemented) command as given in "cmd".
!
PROCEDURE vi$do_command (cmd)
LOCAL
rng,
outf,
mode,
token_1,
token_2,
token_3,
res_spec,
start_mark,
end_mark,
start_line,
end_line,
work_range,
whole_range,
buf,
pos,
spos,
rest,
separ,
no_spec,
ch,
i,
j,
olen,
bang,
num,
pos;
olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
! Start at beginning of string and look for a range of lines.
i := 1;
pos := MARK (NONE);
num := vi$get_line_spec (i, cmd);
no_spec := 0;
IF (num < 0) THEN
IF (vi$parse_next_ch (i, cmd, "%")) THEN
start_line := 1;
end_line := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
ELSE
no_spec := 1;
start_line := vi$cur_line_no;
end_line := start_line;
ENDIF;
ELSE
start_line := num;
IF (vi$parse_next_ch (i, cmd, ",")) THEN
num := vi$get_line_spec (i, cmd);
IF (num < 0) THEN
vi$message ("Invalid line range specification!");
RETURN (1);
ENDIF;
end_line := num;
ELSE
end_line := start_line;
ENDIF;
ENDIF;
POSITION (pos);
work_range := 0;
whole_range := 0;
IF (start_line > end_line) THEN
vi$message ("Bad range of lines!");
RETURN (1);
ENDIF;
start_mark := vi$mark_line (start_line);
end_mark := vi$mark_line (end_line);
IF (start_mark = 0) OR (end_mark = 0) THEN
vi$message ("Bad range of lines!");
RETURN (1);
ENDIF;
work_range := CREATE_RANGE (start_mark, end_mark, NONE);
pos := MARK (NONE);
POSITION (end_mark);
IF (end_mark <> END_OF (CURRENT_BUFFER)) THEN
MOVE_VERTICAL (1);
ENDIF;
IF (end_mark <> BEGINNING_OF (CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (-1);
ENDIF;
whole_range := CREATE_RANGE (start_mark, MARK (NONE), NONE);
POSITION (pos);
! If there is no command then move to the line indicated.
rest := vi$rest_of_line (cmd, i);
EDIT (rest, COLLAPSE);
IF rest = "" THEN
vi$old_place := MARK (NONE);
POSITION (start_mark);
RETURN (0);
ENDIF;
token_1 := vi$get_cmd_token (vi$_lower_chars, cmd, i);
IF (token_1 = "help") THEN
RETURN (vi$do_help (vi$rest_of_line (cmd, i)));
ENDIF;
IF (token_1 = "show") THEN
RETURN (vi$do_show (cmd, i));
ENDIF;
! Check for substitution alias.
IF (token_1 = "") AND (vi$parse_next_ch (i, cmd, "&")) THEN
RETURN (vi$do_subs_alias (cmd, i, start_line, end_line, whole_range));
ENDIF;
IF (token_1 = "") AND (vi$parse_next_ch (i, cmd, "@")) THEN
RETURN (vi$do_macro_buffer (cmd, i));
ENDIF;
IF (token_1 = "learn") THEN
RETURN (vi$do_learn (cmd, i));
ENDIF;
IF (token_1 = "unlearn") THEN
RETURN (vi$do_unlearn (cmd, i));
ENDIF;
IF (token_1 = "g") THEN
RETURN (vi$do_global (cmd, i));
ENDIF;
IF (token_1 = "sh") OR (token_1 = "dcl") THEN
RETURN (vi$spawn (0));
ENDIF;
IF (vi$leading_str (token_1, "unabbr") AND (LENGTH (token_1) > 4)) THEN
RETURN (vi$do_unabbr (cmd, i));
ENDIF;
IF (vi$leading_str (token_1, "abbr") AND (LENGTH (token_1) > 3)) THEN
RETURN (vi$do_abbr (cmd, i));
ENDIF;
IF (vi$leading_str (token_1, "edit")) OR
(vi$leading_str (token_1, "vi")) THEN
RETURN (vi$do_edit (cmd, i, token_1));
ENDIF;
IF (token_1 = "") THEN
IF (vi$parse_next_ch (i, cmd, "!")) THEN
RETURN (vi$do_subproc (cmd, i));
ENDIF;
ENDIF;
IF (vi$leading_str (token_1, "copy")) THEN
RETURN (vi$do_copy (cmd, i, whole_range, olen, start_line, end_line));
ENDIF;
IF (vi$leading_str (token_1, "move")) THEN
RETURN (vi$do_move (cmd, i, whole_range, start_line, end_line));
ENDIF;
IF (vi$leading_str (token_1, "select")) AND (LENGTH (token_1) > 2) THEN
RETURN (vi$do_select);
ENDIF;
IF (token_1 = "fill") THEN
RETURN (vi$do_fill (cmd, i, whole_range, olen));
ENDIF;
IF ((LENGTH (token_1) > 1) AND (vi$leading_str (token_1, "upper") OR
vi$leading_str (token_1, "lower") OR
vi$leading_str (token_1, "invert"))) THEN
RETURN (vi$do_case (token_1, whole_range));
ENDIF;
IF (token_1 = "s") THEN
RETURN (vi$do_substitute (start_line, end_line, whole_range, i, cmd));
ENDIF;
IF (token_1 = "d") THEN
RETURN (vi$do_delete (start_mark, whole_range, olen));
ENDIF;
! Do the write file command. You can write either a buffer, or a
! portion of one.
IF (vi$leading_str (token_1, "write")) THEN
RETURN (vi$do_write (cmd, i, no_spec, token_1, whole_range));
ENDIF;
IF (token_1 = "wq") THEN
RETURN (vi$do_wq (cmd, i, no_spec, token_1, whole_range));
ENDIF;
! Read in a file to the current buffer.
IF (vi$leading_str (token_1, "read")) THEN
RETURN (vi$do_read (cmd, i, start_line, olen));
ENDIF;
IF (vi$leading_str (token_1, "file")) THEN
RETURN (vi$do_file_ex (cmd, i));
ENDIF;
IF (vi$leading_str (token_1, "buffer")) THEN
RETURN (vi$do_buffer (cmd, i, token_1));
ENDIF;
IF (token_1 = "so") THEN
RETURN (vi$do_file (vi$rest_of_line (cmd, i), 1));
ENDIF;
IF (vi$leading_str (token_1, "messages")) THEN
RETURN (vi$do_messages);
ENDIF;
IF (vi$leading_str (token_1, "delbuf")) THEN
RETURN (vi$do_delbuf (cmd, i));
ENDIF;
IF (vi$leading_str (token_1, "xit")) THEN
RETURN (vi$_ZZ);
ENDIF;
IF (token_1 = "rew") THEN
RETURN (vi$_first_file);
ENDIF;
IF (vi$leading_str (token_1, "prev")) THEN
RETURN (vi$_previous_file);
ENDIF;
IF (vi$leading_str (token_1, "next")) THEN
RETURN (vi$_next_file);
ENDIF;
IF (token_1 = "tag") OR (token_1 = "ta") THEN
vi$skip_white (cmd, i);
IF (vi$rest_of_line (cmd, i) = "") THEN
RETURN (vi$do_tag (0));
ELSE
RETURN (vi$do_tag (vi$rest_of_line (cmd, i)));
ENDIF;
ENDIF;
IF (token_1 = "map") THEN
RETURN (vi$map_keys (cmd, i));
ENDIF;
IF (token_1 = "unmap") THEN
RETURN (vi$unmap_keys (cmd, i));
ENDIF;
IF (token_1 = "set") THEN
RETURN (vi$set_commands (cmd, i));
ENDIF;
IF (token_1 = "tpu") THEN
RETURN (vi$do_tpu (cmd, i, no_spec, whole_range));
ENDIF;
IF (token_1 = "cd") OR (token_1 = "chdir") THEN
RETURN (vi$do_cd (cmd, i));
ENDIF;
! Quit the current editor session.
IF (vi$leading_str (token_1, "quit")) THEN
RETURN (vi$do_quit (cmd, token_1));
ENDIF;
MESSAGE ("Unrecognized command!");
RETURN (1);
ENDPROCEDURE;
!
!
!
PROCEDURE vi$do_unlearn (cmd, i)
LOCAL
keyn,
com;
MESSAGE ("Press the key you want to unlearn: ");
keyn := vi$read_a_key;
IF (keyn = F11) OR (ASCII (27) = ASCII (keyn)) THEN
MESSAGE ("UNLEARN aborted!");
RETURN (1);
ENDIF;
com := LOOKUP_KEY (keyn, COMMENT, vi$cmd_keys);
IF (com <> "learn_sequence") THEN
MESSAGE ("That key is not a learned KEY!");
RETURN (1);
ENDIF;
UNDEFINE_KEY (keyn, vi$cmd_keys);
ENDPROCEDURE;
!
!
!
PROCEDURE vi$do_learn (cmd, i)
LOCAL
keyn,
strg;
MESSAGE ("Type KEY sequence, and press CTRL-R to remember sequence");
vi$in_learn := 1;
LEARN_BEGIN (EXACT);
RETURN (1);
ENDPROCEDURE;
!
! Remember the keystrokes that have been typed.
!
PROCEDURE vi$remember
LOCAL
key,
keyn,
com;
ON_ERROR
RETURN (1);
ENDON_ERROR;
IF (vi$in_learn = 0) THEN
RETURN (0);
ENDIF;
MESSAGE ("Press key to bind sequence to: ");
keyn := vi$read_a_key;
IF (keyn = F11) OR (ASCII (27) = ASCII (keyn)) THEN
MESSAGE ("LEARN aborted!");
com := LEARN_END;
vi$in_learn := 0;
RETURN (1);
ENDIF;
com := LOOKUP_KEY (keyn, COMMENT, vi$cmd_keys);
IF (com = "active_macro") THEN
MESSAGE ("That key is a mapped key, you must unmap it first");
RETURN (1);
ENDIF;
key := "vi$ls_"+vi$key_map_name (keyn);
EXECUTE (COMPILE (key+":=LEARN_END"));
vi$in_learn := 0;
DEFINE_KEY ("vi$play_back("+key+")", keyn, "learn_sequence", vi$cmd_keys);
MESSAGE ("Sequence bound to key");
RETURN (1);
ENDPROCEDURE;
!
!
!
PROCEDURE vi$play_back (prog)
LOCAL
old_play_back,
old_global;
IF (vi$m_level > 30) THEN
MESSAGE ("Infinite loop detected in key macro sequence!");
RETURN;
ENDIF;
vi$m_level := vi$m_level + 1;
IF vi$undo_map THEN
old_global := vi$in_global;
vi$in_global := 0;
IF (NOT old_global) THEN
vi$save_for_undo (CURRENT_BUFFER, VI$LINE_MODE, 1);
vi$in_global := 1;
ENDIF;
ENDIF;
old_play_back := vi$playing_back;
vi$playing_back := 1;
EXECUTE (prog);
vi$playing_back := old_play_back;
vi$m_level := vi$m_level - 1;
vi$in_global := old_global;
ENDPROCEDURE;
!
! Remove an abbreviation
!
PROCEDURE vi$do_unabbr (cmd, i)
LOCAL
separ,
junk,
idx,
ch,
abbr,
abbrn;
abbr := "";
abbrn := "";
junk := vi$skip_separ (cmd, i, " ", separ);
IF (LENGTH (junk) = 0) THEN
MESSAGE ("Abbreviation name required!");
RETURN (1);
ENDIF;
idx := 1;
LOOP
EXITIF idx > LENGTH (junk);
ch := SUBSTR (junk, idx, 1);
IF (INDEX (vi$_alpha_chars, ch) = 0) THEN
MESSAGE ("Invalid character in UNABBR name, '"+ch+
"', is not valid.");
RETURN (1);
ENDIF;
IF (INDEX (vi$_upper_chars, ch) <> 0) THEN
abbrn := abbrn + "_";
ENDIF;
abbrn := abbrn + ch;
idx := idx + 1;
ENDLOOP;
EXECUTE (COMPILE ("VI$ABBR_"+abbrn+":=0;"));
RETURN (0);
ENDPROCEDURE;
!
! Create an abbreviation
!
PROCEDURE vi$do_abbr (cmd, i)
LOCAL
separ,
abbr,
junk,
idx,
ch,
abbrn;
abbr := "";
abbrn := "";
junk := vi$skip_separ (cmd, i, " ", separ);
IF (LENGTH (junk) = 0) THEN
vi$show_abbrevs;
RETURN (0);
ENDIF;
idx := 1;
LOOP
EXITIF idx > LENGTH (junk);
ch := SUBSTR (junk, idx, 1);
IF (INDEX (vi$_alpha_chars, ch) = 0) THEN
MESSAGE ("Invalid character in ABBR name, '"+ch+"', is not valid.")
;
RETURN (1);
ENDIF;
IF (INDEX (vi$_upper_chars+"_", ch) <> 0) THEN
abbrn := abbrn + "_";
ENDIF;
abbrn := abbrn + ch;
idx := idx + 1;
ENDLOOP;
abbr := vi$rest_of_line (cmd, i);
EXECUTE (COMPILE ("VI$ABBR_"+abbrn+":="""+abbr+""""));
RETURN (0);
ENDPROCEDURE;
!
! Execute the contents of the buffers named following an '@'.
!
PROCEDURE vi$do_macro_buffer (cmd, i)
LOCAL
line,
mode,
buf_name,
pos,
buf,
ch;
ON_ERROR
ENDON_ERROR;
vi$skip_white (cmd, i);
LOOP
ch := vi$next_char (cmd, i);
EXITIF (ch = "");
IF (INDEX ("123456789", ch) <> 0) THEN
! Selected a deletion buffer.
buf_name := "vi$del_buf_" + ch;
ELSE
IF (INDEX (vi$_letter_chars, ch) <> 0) THEN
! Selected a named buffer.
CHANGE_CASE (ch, LOWER);
buf_name := "vi$ins_buf_" + ch;
ELSE
vi$message ("Invalid buffer!");
RETURN;
ENDIF;
ENDIF;
vi$global_var := 0;
EXECUTE (COMPILE ("vi$global_var := "+buf_name+";"));
buf := vi$global_var;
IF (buf = 0) THEN
vi$message ("There is no text in that buffer!");
RETURN;
ENDIF;
pos := MARK (NONE);
POSITION (BEGINNING_OF (buf));
! Skip the buffer mode indicator.
mode := INT (vi$current_line);
MOVE_VERTICAL (1);
line := vi$current_line;
IF mode = VI$LINE_MODE THEN
line := line + ASCII (13);
ENDIF;
POSITION (pos);
vi$do_macro (line, 1);
ENDLOOP;
ENDPROCEDURE;
!
!
!
PROCEDURE vi$do_global (cmd, i)
LOCAL
cmd_str,
sch_str,
subs_str,
sch,
ch,
nsubs,
lpos,
olen,
fpos;
olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
vi$skip_white (cmd, i);
IF NOT vi$parse_next_ch (i, cmd, "/") THEN
MESSAGE ("/ Search string must follow global!");
RETURN (1);
ENDIF;
sch := SUBSTR (cmd, i-1, 1);
sch_str := "";
LOOP
EXITIF (vi$parse_next_ch (i, cmd, sch));
EXITIF (LENGTH (cmd) < i);
ch := SUBSTR (cmd, i, 1);
IF (ch = "\") THEN
sch_str := sch_str + SUBSTR (cmd, i, 2);
i := i + 1;
ELSE
sch_str := sch_str + ch;
ENDIF;
i := i + 1;
ENDLOOP;
IF (LENGTH (cmd) < i) THEN
MESSAGE ("Incomplete command!");
RETURN (1);
ENDIF;
vi$save_for_undo (CURRENT_BUFFER, VI$LINE_MODE, 1);
cmd_str := vi$rest_of_line (cmd, i);
SET (FORWARD, CURRENT_BUFFER);
POSITION (BEGINNING_OF (CURRENT_BUFFER));
nsubs := 0;
subs_str := SUBSTR (cmd_str, 2, 255);
LOOP
fpos := vi$find_str (sch_str, 1);
EXITIF fpos = 0;
POSITION (fpos);
IF cmd_str = "d" THEN
ERASE_LINE;
ELSE
IF SUBSTR (cmd_str, 1, 1) = "s" THEN
lpos := vi$global_subs (subs_str, nsubs);
MOVE_HORIZONTAL (-CURRENT_OFFSET);
MOVE_VERTICAL (1);
ELSE
MESSAGE ("Bad command for global: "+cmd_str);
vi$kill_undo;
vi$undo_end := 0;
$$EOD$$