v04i101: TPUVI for VMS part 10 of 17
Gregg Wonderly
gregg at a.cs.okstate.edu
Tue Sep 27 11:55:35 AEST 1988
Posting-number: Volume 4, Issue 101
Submitted-by: "Gregg Wonderly" <gregg at a.cs.okstate.edu>
Archive-name: vms-vi-2/Part10
$ WRITE SYS$OUTPUT "Creating ""VI.6"""
$ CREATE VI.6
$ DECK/DOLLARS=$$EOD$$
ELSE
IF (vi$wrap_scan = 1) THEN
POSITION (BEGINNING_OF (CURRENT_BUFFER));
ENDIF;
ENDIF;
ELSE
prompt := "?" + vi$search_string;
SET (REVERSE, CURRENT_BUFFER);
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
IF (SUBSTR (prompt, 1, 3) = "?\<") THEN
MOVE_HORIZONTAL (-2);
ELSE
MOVE_HORIZONTAL (-1);
ENDIF;
ELSE
IF (vi$wrap_scan = 1) THEN
POSITION (END_OF (CURRENT_BUFFER));
ENDIF;
ENDIF;
ENDIF;
MESSAGE (prompt);
! On success then return the position we moved to.
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;
IF (where = 0) THEN
vi$info ("String not found");
ELSE
POSITION (BEGINNING_OF (where));
bpos := MARK (NONE);
POSITION (END_OF (where));
vi$find_rng := CREATE_RANGE (bpos, MARK(NONE), BOLD);
MESSAGE ("");
ENDIF;
POSITION (pos);
RETURN (where);
ENDPROCEDURE;
!
! This procedure can be used to find a string of text (using RE's).
! The current direction of the BUFFER is used to determine which way
! the search goes. 'replace' is used by the replace code to indicate
! that wrap scan should be performed.
!
PROCEDURE vi$find_str (sstr, replace, do_parens)
LOCAL
pos,
new_pat,
start,
where;
ON_ERROR
ENDON_ERROR;
pos := MARK (NONE);
vi$paren_cnt := 0;
IF vi$magic THEN
new_pat := vi$re_pattern_gen (sstr, vi$paren_cnt, do_parens);
ELSE
new_pat := vi$pattern_gen (sstr);
ENDIF;
IF (new_pat <> 0) THEN
EXECUTE (COMPILE ("vi$_find_pat := " + new_pat));
where := SEARCH (vi$_find_pat, CURRENT_DIRECTION, vi$ignore_case);
IF (where = 0) AND (vi$wrap_scan = 1) AND (replace = 0) THEN
IF (CURRENT_DIRECTION = FORWARD) THEN
POSITION (BEGINNING_OF (CURRENT_BUFFER));
ELSE
POSITION (END_OF (CURRENT_BUFFER));
ENDIF;
where := SEARCH (vi$_find_pat, CURRENT_DIRECTION, vi$ignore_case);
ENDIF;
ELSE
where := 0;
ENDIF;
IF (where <> 0) AND (vi$in_ws) THEN
POSITION (BEGINNING_OF (where));
IF (CURRENT_OFFSET <> 0) OR
(INDEX (vi$_ws, CURRENT_CHARACTER) <> 0) THEN
MOVE_HORIZONTAL (1);
ENDIF;
start := MARK (NONE);
POSITION (END_OF (where));
IF (CURRENT_OFFSET <> LENGTH (CURRENT_LINE)) THEN
MOVE_HORIZONTAL (-1);
ENDIF;
where := CREATE_RANGE (start, MARK (NONE), NONE);
POSITION (pos);
ENDIF;
RETURN (where);
ENDPROCEDURE;
!
! Generate a TPU pattern string, not using RE's, i.e. :set nomagic is
! in effect when this routine is used.
!
PROCEDURE vi$pattern_gen (pat)
LOCAL
first, ! First pattern to be done
part_pat,
chno,
startchar,
haveany,
regular,
tstr,
endchar,
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
pos; ! The position within the regular
! expression string that we are examining
! currently
IF (INDEX (pat, "$") <> 0) OR (INDEX (pat, "^") <> 0) THEN
new_pat := "";
ELSE
new_pat := '"'+pat+'"';
RETURN (new_pat);
ENDIF;
pos := 1;
IF SUBSTR (pat, pos, 1) = "^" THEN
IF LENGTH (pat) > 1 THEN
new_pat := "line_begin & '";
ELSE
new_pat := "line_begin";
ENDIF;
pos := pos + 1;
ENDIF;
LOOP
EXITIF (pos > LENGTH (pat));
regular := 0;
cur_pat := "";
cur_char := substr (pat, pos, 1);
IF (cur_char = "$") AND (pos+1 >= LENGTH (pat)) THEN
IF pos <> 1 THEN
cur_pat := "' & line_end";
ELSE
cur_pat := "line_end";
ENDIF;
ELSE
cur_pat := cur_char;
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;
IF (regular) THEN
new_pat := new_pat + "'";
ENDIF;
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, paren_cnt, do_parens)
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
vi$info ("^ found in the middle of a line, use \ to escape it!");
RETURN (0);
ENDIF;
IF (cur_char = "$") THEN
IF (pos >= LENGTH (pat)) THEN
cur_pat := "line_end";
ELSE
vi$info ("$ 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$info ("Missing character after \");
RETURN (0);
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$info ("Missing character after '-'");
RETURN (0);
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$info (
"Invalid character sequence for '-'");
RETURN (0);
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$info ("No text found between []");
RETURN (0);
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 (do_parens) THEN
IF (startchar = "(") THEN
paren_cnt := paren_cnt + 1;
IF tstr = '"' THEN
tstr := '""@o'+STR(paren_cnt)+'&"';
ELSE
tstr := tstr + '"@o'+STR(paren_cnt)+'&"';
ENDIF;
ELSE
IF (startchar = ")") THEN
IF (paren_cnt = 0) THEN
vi$info (
FAO ("No previous ""\("" near: !AS",
SUBSTR (pat, pos, LENGTH(pat)-pos))
);
RETURN (0);
ENDIF;
IF tstr = '"' THEN
tstr := '""@p'+STR(paren_cnt)+'&"';
ELSE
tstr := tstr + '"@p' +
STR(paren_cnt)+'&"';
ENDIF;
ELSE
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 + SUBSTR (pat, pos, 1);
ENDIF;
ENDIF;
ENDIF;
ENDIF;
ELSE
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;
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
vi$info ("Missing \> in pattern!");
RETURN (0);
ENDIF;
RETURN (new_pat);
ENDPROCEDURE;
!
! Match brackets when '%' is typed.
!
PROCEDURE vi$_match_brackets
vi$beep_position (vi$match_brackets, 1, 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;
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$info ("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$info ("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$info ("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 vi$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 ((top + len/2 - 1) - cur);
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
cnt,
pos;
ON_ERROR
POSITION (pos);
vi$active_count := 0;
RETURN (0);
ENDON_ERROR;
pos := MARK (NONE);
POSITION (LINE_BEGIN);
cnt := vi$active_count;
IF cnt = 0 THEN
cnt := 1;
ENDIF;
MOVE_VERTICAL (cnt - 1);
IF (CURRENT_CHARACTER = "") THEN
RETURN (0);
ENDIF;
POSITION (LINE_END);
vi$check_rmarg;
IF (vi$active_count > 0) THEN
vi$yank_mode := VI$LINE_MODE;
ELSE
vi$yank_mode := VI$IN_LINE_MODE;
ENDIF;
vi$active_count := 0;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! Move the first non-blank character of the line when '^' is typed.
!
PROCEDURE vi$_bol (use_cur_active)
vi$beep_position (vi$first_no_space (use_cur_active), 0, 1);
ENDPROCEDURE;
!
! Move the beginning of the line when '0' is typed.
!
PROCEDURE vi$fol
LOCAL
pos;
pos := MARK (NONE);
POSITION (LINE_BEGIN);
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
opos,
pos;
opos := MARK (NONE);
pos := vi$search(direction);
IF (vi$beep_position (pos, 1, 0) <> 0) THEN
POSITION (opos);
vi$pos_in_middle (pos);
ENDIF;
ENDPROCEDURE;
!
! Move to the next location of the string previously searched for.
!
PROCEDURE vi$_search_next (direction)
LOCAL
opos,
pos;
opos := MARK(NONE);
pos := vi$search_next(direction);
IF (vi$beep_position (pos, 1, 0) <> 0) THEN
POSITION (opos);
vi$pos_in_middle (pos);
ENDIF;
ENDPROCEDURE;
!
! Repeat the last 't' or 'f' command backwards.
!
PROCEDURE vi$_repeat_torf_back
vi$beep_position (vi$repeat_torf_back, 0, 1);
ENDPROCEDURE
!
! Repeat the last 't' or 'f' command.
!
PROCEDURE vi$_repeat_torf
vi$beep_position (vi$repeat_torf, 0, 1);
ENDPROCEDURE
!
! Return the location found by repeating the last 't', 'f', 'T' or 'F'
! command backwards.
!
PROCEDURE vi$repeat_torf_back
LOCAL
ch,
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;
ch := vi$last_s_char;
IF (ch = "'") THEN
ch := "''";
ENDIF;
EXECUTE (COMPILE (
"vi$global_var := " + back_func + "('"+ ch + "')"));
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
LOCAL
ch;
vi$global_var := 0;
ch := vi$last_s_char;
IF (ch = "'") THEN
ch := "''";
ENDIF;
IF (vi$last_s_func <> 0) THEN
EXECUTE (COMPILE (
"vi$global_var := " + vi$last_s_func + "('"+ ch + "')"));
ELSE
vi$beep;
ENDIF;
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
vi$do_cmd_line (cmd_str);
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 (INT(ch) <= INT(KEY_NAME (ASCII (31)))) AND
(INT (ch) >= INT(CTRL_A_KEY)) THEN
IF ch = TAB_KEY THEN
addch := 9;
COPY_TEXT (ASCII(addch));
ELSE
addch := ((INT(ch) - INT(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);
vi$update (CURRENT_WINDOW);
IF (cmd_idx > 0) THEN
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;
ENDIF;
UNMAP (command_window);
UNMAP (message_window);
MAP (message_window, message_buffer);
POSITION (win);
POSITION (pos);
RETURN (cmd_idx > 0);
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);
POSITION (LINE_BEGIN);
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);
POSITION (LINE_END);
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);
ENDIF;
strg := "";
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 <> "") THEN
IF (vi$do_command (strg) <> 0) THEN
RETURN (1);
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,
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);
IF (num < 0) THEN
vi$info ("search line not found!");
POSITION (pos);
RETURN (1);
ENDIF;
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$info ("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$info ("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$info ("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 (vi$leading_str (token_1, "version") AND (LENGTH (token_1) > 2)) THEN
vi$info (vi$_version);
RETURN (0);
ENDIF;
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 = "v") THEN
RETURN (vi$do_global (cmd, i, "v"));
ENDIF;
IF (token_1 = "g") THEN
RETURN (vi$do_global (cmd, i, "g"));
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 (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;
IF (token_1 = "p") THEN
RETURN (vi$do_print (start_mark, start_line, end_line));
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 (KEY_NAME ('Z')));
ENDIF;
IF (token_1 = "rew") THEN
RETURN (vi$_first_file (vi$parse_next_ch (i, cmd, "!")));
ENDIF;
IF (vi$leading_str (token_1, "prev")) THEN
RETURN (vi$_previous_file (vi$parse_next_ch (i, cmd, "!")));
ENDIF;
IF (vi$leading_str (token_1, "next")) THEN
RETURN (vi$_next_file (vi$parse_next_ch (i, cmd, "!")));
ENDIF;
IF (token_1 = "tag") OR (token_1 = "ta") THEN
token_1 := vi$parse_next_ch (i, cmd, "!");
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") OR (token_1 = "se") 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;
vi$info ("Unrecognized command! ("+cmd+")");
RETURN (1);
ENDPROCEDURE;
!
!
!
PROCEDURE vi$do_unlearn (cmd, i)
LOCAL
keyn,
com;
vi$info ("Press the key you want to unlearn: ");
keyn := vi$read_a_key;
IF (keyn = F11) OR (ASCII (27) = ASCII (keyn)) THEN
vi$info ("UNLEARN aborted!");
RETURN (1);
ENDIF;
com := LOOKUP_KEY (keyn, COMMENT, vi$cmd_keys);
IF (com <> "learn_sequence") THEN
vi$info ("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;
vi$info ("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;
$$EOD$$
More information about the Comp.sources.misc
mailing list