v04i104: TPUVI for VMS part 13 of 17
Gregg Wonderly
gregg at a.cs.okstate.edu
Wed Sep 28 08:17:44 AEST 1988
Posting-number: Volume 4, Issue 104
Submitted-by: "Gregg Wonderly" <gregg at a.cs.okstate.edu>
Archive-name: vms-vi-2/Part13
$ WRITE SYS$OUTPUT "Creating ""VI.9"""
$ CREATE VI.9
$ DECK/DOLLARS=$$EOD$$
IF (token_1 = "nomagic") THEN
vi$magic := 0;
RETURN (0);
ENDIF;
IF (token_1 = "noerrorbells") OR (token_1 = "noeb") THEN
vi$error_bells := 0;
RETURN (0);
ENDIF;
IF (token_1 = "errorbells") OR (token_1 = "eb") THEN
vi$error_bells := 1;
RETURN (0);
ENDIF;
IF (token_1 = "nowrapscan") OR (token_1 = "nows") THEN
vi$wrap_scan := 0;
RETURN (0);
ENDIF;
IF (token_1 = "wrapscan") OR (token_1 = "ws") THEN
vi$wrap_scan := 1;
RETURN (0);
ENDIF;
IF (token_1 = "noupdate") THEN
vi$min_update := 1;
RETURN (0);
ENDIF;
IF (token_1 = "update") THEN
vi$min_update := 0;
RETURN (0);
ENDIF;
IF (token_1 = "noshowmode") OR (token_1 = "nosm") THEN
vi$show_mode := 0;
RETURN (0);
ENDIF;
IF (token_1 = "showmode") OR (token_1 = "sm") THEN
vi$show_mode := 1;
RETURN (0);
ENDIF;
IF (token_1 = "wrapmargin") OR (token_1 = "wm") THEN
token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), separ);
vi$wrap_margin := INT (token_2);
RETURN (0);
ENDIF;
IF (token_1 = "sections") OR (token_1 = "sect") THEN
pstr := "LINE_BEGIN&((";
use_fortran := 0;
vi$sect_str := "";
LOOP
EXITIF (SUBSTR (cmd, i, 1) = " ") OR (i >= LENGTH (cmd));
npat := SUBSTR (cmd, i, 2);
vi$sect_str := vi$sect_str + npat;
EDIT (npat, COLLAPSE);
IF (npat = "+c") OR (npat = "+C") THEN
pstr := pstr + '"{"';
ELSE
IF (npat = "+f") OR (npat = "+F") THEN
use_fortran := 1;
npat := "";
ELSE
IF (npat = "+t") OR (npat = "+T") THEN
pstr := pstr + '"PROCEDURE"';
ELSE
pstr := pstr + '".' + npat + '"';
ENDIF;
ENDIF;
ENDIF;
i := i + 2;
EXITIF (SUBSTR (cmd, i, 1) = " ") OR (i >= LENGTH (cmd));
IF (npat <> "") THEN
pstr := pstr + "|";
ENDIF;
ENDLOOP;
pstr := pstr + ")";
IF (use_fortran) THEN
pstr := '("FUNCTION"|"SUBROUTINE")|('+ pstr + "))|LINE_END)";
ENDIF;
EXECUTE (COMPILE ("vi$sect_pat:="+pstr+";"));
RETURN (0);
ENDIF;
IF (token_1 = "paragraphs") OR (token_1 = "para") THEN
pstr := 'LINE_BEGIN&((';
vi$para_str := "";
LOOP
EXITIF (SUBSTR (cmd, i, 1) = " ") OR (i >= LENGTH (cmd));
npat := SUBSTR (cmd, i, 2);
vi$para_str := vi$para_str + npat;
EDIT (npat, COLLAPSE);
pstr := pstr + '".' + npat + '"';
i := i + 2;
EXITIF (SUBSTR (cmd, i, 1) = " ") OR (i >= LENGTH (cmd));
IF (npat <> "") THEN
pstr := pstr + "|";
ENDIF;
ENDLOOP;
pstr := pstr + ")|LINE_END)";
EXECUTE (COMPILE ("vi$para_pat:="+pstr+";"));
RETURN (0);
ENDIF;
IF (token_1 = "number") OR
(token_1 = "optimize") OR
(token_1 = "noautoprint") OR
(token_1 = "novice") OR
(token_1 = "slowopen") OR
(token_1 = "noslowopen") OR
(token_1 = "beautify") OR
(token_1 = "taglength") OR
(token_1 = "directory") OR
(token_1 = "noprompt") OR
(token_1 = "edcompatible") OR
(token_1 = "term") OR
(token_1 = "noredraw") OR
(token_1 = "redraw") OR
(token_1 = "terse") OR
(token_1 = "flash") OR
(token_1 = "noremap") OR
(token_1 = "timeout") OR
(token_1 = "hardtabs") OR
(token_1 = "ttytype") OR
(token_1 = "warn") OR
(token_1 = "nowarn") OR
(token_1 = "lisp") OR
(token_1 = "list") OR
(token_1 = "sh") OR
(token_1 = "shell") OR
(token_1 = "mesg") OR
(token_1 = "nomesg") OR
(token_1 = "showmatch") THEN
vi$not_implemented (token_1);
RETURN (1);
ENDIF;
vi$info ("Unrecognized option ("+token_1+
"), use `set all' to see options.");
RETURN (1);
ENDPROCEDURE;
!
! Set the window length to the integer value passed.
!
PROCEDURE vi$do_set_window (len)
LOCAL
buf,
curwin,
curbuf;
curwin := CURRENT_WINDOW;
curbuf := CURRENT_BUFFER;
IF (vi$prev_win (curwin) = 0) AND (vi$next_win (curwin) = 0)
AND (NOT vi$in_occlusion) THEN
IF len < 3 THEN
len := 3;
ENDIF;
IF len > GET_INFO (SCREEN, "VISIBLE_LENGTH") THEN
len := GET_INFO (SCREEN, "VISIBLE_LENGTH");
ENDIF;
oldscrlen := vi$scr_length;
vi$scr_length := len;
ADJUST_WINDOW (curwin, 0, vi$scr_length - oldscrlen);
buf := GET_INFO (message_window, "BUFFER");
UNMAP (message_window);
DELETE (message_window);
message_window := CREATE_WINDOW (vi$scr_length - 1, 2, ON);
MAP (message_window, buf);
SET (STATUS_LINE, message_window, NONE, "");
ADJUST_WINDOW (message_window, 1, 0);
DELETE (command_window);
command_window := CREATE_WINDOW (vi$scr_length, 1, OFF);
buf := GET_INFO (info_window, "BUFFER");
DELETE (info_window);
info_window := CREATE_WINDOW (1, vi$scr_length - 1, ON);
SET (STATUS_LINE, info_window, NONE, "");
SET (PROMPT_AREA, vi$scr_length, 1, REVERSE);
POSITION (curbuf);
POSITION (curwin);
UNMAP (curwin);
MAP (curwin, curbuf);
ELSE
vi$info (
"Can't change length of screen while multiple windows visible!");
RETURN (1);
ENDIF;
vi$how_much_scroll := vi$scr_length / 2;
RETURN (0);
ENDPROCEDURE;
!
! Show the current settings when ":set all" is issued.
!
PROCEDURE vi$show_settings
LOCAL
bname,
readonly,
obuf,
ic,
ostat,
ovid,
buf;
buf := vi$init_buffer ("$$vi_set_all$$", "");
ostat := GET_INFO (CURRENT_WINDOW, "STATUS_LINE");
IF (ostat = 0) THEN
ostat := "";
ENDIF;
ovid := GET_INFO (CURRENT_WINDOW, "STATUS_VIDEO");
IF (ovid = 0) THEN
ovid := NONE;
ENDIF;
SET (STATUS_LINE, CURRENT_WINDOW, NONE, "");
SET (STATUS_LINE, CURRENT_WINDOW, REVERSE,
" Current settings of VI options");
SET (EOB_TEXT, buf,
" [Hit ENTER to continue editing]");
obuf := CURRENT_BUFFER;
POSITION (buf);
IF vi$ignore_case = EXACT THEN
ic := 2;
ELSE
ic := 0;
ENDIF;
COPY_TEXT (FAO (
"!20<wrapmargin=!UL!>!20<tabstop=!UL!>!20<!ASmagic!>!20<!ASignorecase!>",
vi$wrap_margin, vi$tab_amount,
SUBSTR ("no", 1, (1-vi$magic)*2),
SUBSTR ("no", 1, ic)));
SPLIT_LINE;
COPY_TEXT (FAO (
"!20<shiftwidth=!UL!>!20<scroll=!UL!>!20<report=!UL!>!20<!ASautowrite!>",
vi$shift_width, vi$how_much_scroll, vi$report,
SUBSTR ("no", 1, (1-vi$auto_write)*2)));
SPLIT_LINE;
COPY_TEXT (FAO (
"!20<!ASwrapscan!>!20<!ASupdate!>!20<!AStabs!>!20<!ASundomap!>",
SUBSTR ("no", 1, (1-vi$wrap_scan)*2),
SUBSTR ("no", 1, (vi$min_update)*2),
SUBSTR ("no", 1, (1-vi$use_tabs)*2),
SUBSTR ("no", 1, (1-vi$undo_map)*2)
));
SPLIT_LINE;
IF vi$tag_case = EXACT THEN
ic := 0;
ELSE
ic := 2;
ENDIF;
COPY_TEXT (FAO (
"!20<!AStagcase!>!20<window=!UL!>!20<width=!UL!>tags=!AS",
SUBSTR ("no", 1, ic),
GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH"),
GET_INFO (CURRENT_WINDOW, "WIDTH"),
vi$tag_files
));
SPLIT_LINE;
COPY_TEXT (FAO (
"!20<!ASerrorbells!>!20<paragraphs=!AS!>!20<sections=!AS!>"+
"!20<!ASsenddcl!>",
SUBSTR ("no", 1, (1-vi$error_bells)*2),
vi$para_str,
vi$sect_str,
SUBSTR ("no", 1, (1-vi$send_dcl)*2)
));
SPLIT_LINE;
readonly := vi$getbufmode (obuf);
COPY_TEXT (FAO (
"!20<!ASshowmode!>!20<!ASautoindent!>!20<!ASempty!>!20<!ASreadonly!>",
SUBSTR ("no", 1, (1-vi$show_mode)*2),
SUBSTR ("no", 1, (1-vi$auto_indent)*2),
SUBSTR ("no", 1, (vi$delete_empty)*2),
SUBSTR ("no", 1, (1-readonly)*2)
));
SPLIT_LINE;
MAP (CURRENT_WINDOW, buf);
UPDATE (CURRENT_WINDOW);
LOOP
EXITIF vi$read_a_key = RET_KEY;
ENDLOOP;
SET (STATUS_LINE, CURRENT_WINDOW, NONE, "");
SET (STATUS_LINE, CURRENT_WINDOW, ovid, ostat);
MAP (CURRENT_WINDOW, obuf);
POSITION (obuf);
DELETE (buf);
ENDPROCEDURE;
!
!
!
PROCEDURE vi$makebufname (buf)
LOCAL
i,
ch,
bname,
nname;
nname := "";
bname := GET_INFO (buf, "NAME");
i := 1;
LOOP
EXITIF i > LENGTH (bname);
ch := SUBSTR (bname, i, 1);
IF INDEX (vi$_sym_chars, ch) <> 0 THEN
nname := nname + ch;
ENDIF;
i := i + 1;
ENDLOOP;
RETURN (nname);
ENDPROCEDURE;
!
!
!
PROCEDURE vi$getbufmode (buf)
LOCAL
nname;
ON_ERROR
RETURN (1);
ENDON_ERROR;
IF (GET_INFO (buf, "SYSTEM")) THEN
RETURN (1);
ELSE
nname := vi$makebufname (buf);
vi$global_var := 0;
EXECUTE (COMPILE ("vi$global_var := vi$bmode_"+nname));
RETURN (vi$global_var);
ENDIF;
ENDPROCEDURE;
!
!
!
PROCEDURE vi$setbufmode (buf, bmode)
LOCAL
nname;
nname := vi$makebufname (buf);
EXECUTE (COMPILE ("vi$bmode_"+nname+":="+STR(bmode)));
ENDPROCEDURE;
!
! Function to say that a particular command is not implemented.
!
PROCEDURE vi$not_implemented (cmd)
vi$info (cmd + " is not implemented!");
ENDPROCEDURE;
!
! The function mapped to 't'.
!
PROCEDURE vi$_to_char (char_to_find)
LOCAL
char_val;
char_val := char_to_find;
vi$beep_position (vi$to_char (char_val), 0, 1);
ENDPROCEDURE;
!
! Function performing task for 't'.
!
PROCEDURE vi$to_char (ch_to_find)
LOCAL
char_to_find,
act_count,
pos,
found;
char_to_find := ch_to_find;
IF char_to_find = 0 THEN
char_to_find := vi$read_char_to_find;
ENDIF;
vi$last_s_char := char_to_find;
vi$last_s_func := "vi$to_char";
pos := MARK(NONE);
act_count := vi$cur_active_count;
IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
RETURN (0);
ENDIF;
MOVE_HORIZONTAL (1);
IF char_to_find <> ASCII(27) THEN
found := 0;
LOOP
EXITIF (CURRENT_OFFSET >= LENGTH (vi$current_line));
MOVE_HORIZONTAL (1);
found := 1;
IF (CURRENT_CHARACTER = char_to_find) THEN
act_count := act_count - 1;
EXITIF (act_count = 0);
ENDIF;
found := 0;
ENDLOOP;
IF (NOT found) THEN
POSITION (pos);
RETURN (0);
ELSE
vi$move_horizontal (-1);
ENDIF;
ENDIF;
vi$yank_mode := VI$IN_LINE_MODE;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! The function mapped to 'T'.
!
PROCEDURE vi$_back_to_char (char_to_find)
LOCAL
char_val;
char_val := char_to_find;
vi$beep_position (vi$back_to_char (char_val), 0, 1);
ENDPROCEDURE;
!
! Function performing task for 'T'.
!
PROCEDURE vi$back_to_char (ch_to_find)
LOCAL
char_to_find,
act_count,
pos,
found;
char_to_find := ch_to_find;
IF char_to_find = 0 THEN
char_to_find := vi$read_char_to_find;
ENDIF;
vi$last_s_char := char_to_find;
vi$last_s_func := "vi$back_to_char";
pos := MARK(NONE);
IF (CURRENT_OFFSET = 0) THEN
RETURN (0);
ENDIF;
vi$move_horizontal (-1);
IF (CURRENT_CHARACTER <> char_to_find) THEN
vi$move_horizontal (1);
ENDIF;
act_count := vi$cur_active_count;
IF char_to_find <> ASCII(27) THEN
found := 0;
LOOP
EXITIF (CURRENT_OFFSET = 0);
vi$move_horizontal (-1);
found := 1;
IF (CURRENT_CHARACTER = char_to_find) THEN
act_count := act_count - 1;
EXITIF (act_count = 0);
ENDIF;
found := 0;
ENDLOOP;
IF (NOT found) THEN
POSITION (pos);
RETURN (0);
ELSE
MOVE_HORIZONTAL(1);
ENDIF;
ENDIF;
vi$yank_mode := VI$IN_LINE_MODE;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! The function mapped to 'f'.
!
PROCEDURE vi$_find_char (char_to_find)
LOCAL
char_val;
char_val := char_to_find;
vi$beep_position (vi$find_char (char_val), 0, 1);
ENDPROCEDURE;
!
! Function performing task for 'f'.
!
PROCEDURE vi$find_char (ch_to_find)
LOCAL
char_to_find,
act_count,
pos,
found;
char_to_find := ch_to_find;
IF char_to_find = 0 THEN
char_to_find := vi$read_char_to_find;
ENDIF;
vi$last_s_char := char_to_find;
vi$last_s_func := "vi$find_char";
act_count := vi$cur_active_count;
IF char_to_find <> ASCII(27) THEN
pos := MARK(NONE);
found := 0;
LOOP
EXITIF (CURRENT_OFFSET >= LENGTH (vi$current_line));
MOVE_HORIZONTAL (1);
found := 1;
IF (CURRENT_CHARACTER = char_to_find) THEN
act_count := act_count - 1;
EXITIF (act_count = 0);
ENDIF;
found := 0;
ENDLOOP;
IF (NOT found) THEN
POSITION (pos);
RETURN (0);
ENDIF;
ELSE
RETURN (0);
ENDIF;
vi$yank_mode := VI$IN_LINE_MODE;
RETURN (vi$retpos(pos));
ENDPROCEDURE;
!
! The function mapped to 'F'.
!
PROCEDURE vi$_back_find_char (char_to_find)
LOCAL
char_val;
char_val := char_to_find;
vi$beep_position (vi$back_find_char (char_val), 0, 1);
ENDPROCEDURE;
!
! Function performing task for 'F'.
!
PROCEDURE vi$back_find_char (ch_to_find)
LOCAL
char_to_find,
act_count,
pos,
found;
char_to_find := ch_to_find;
IF char_to_find = 0 THEN
char_to_find := vi$read_char_to_find;
ENDIF;
vi$last_s_char := char_to_find;
vi$last_s_func := "vi$back_find_char";
act_count := vi$cur_active_count;
IF char_to_find <> ASCII(27) THEN
pos := MARK(NONE);
LOOP
found := 0;
EXITIF CURRENT_OFFSET = 0;
vi$move_horizontal (-1);
found := 1;
IF (CURRENT_CHARACTER = char_to_find) THEN
act_count := act_count - 1;
EXITIF act_count = 0;
ENDIF;
ENDLOOP;
IF (NOT found) THEN
POSITION (pos);
RETURN (0);
ENDIF;
ENDIF;
vi$yank_mode := VI$IN_LINE_MODE;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! Function to read a key, and change TAB_KEY to ASCII (9). Currently
! used by f, F, t and T commands only.
!
PROCEDURE vi$read_char_to_find
LOCAL
rkey;
rkey := vi$read_a_key;
IF (rkey = TAB_KEY) THEN
RETURN (ASCII (9));
ELSE
IF (rkey = RET_KEY) THEN
RETURN (ASCII (13));
ELSE
IF (rkey = DEL_KEY) THEN
RETURN (ASCII (8));
ENDIF;
ENDIF;
ENDIF;
RETURN (ASCII (rkey));
ENDPROCEDURE;
!
! The function mapped to 'G'.
!
PROCEDURE vi$go_to_line
LOCAL
opos,
curline,
pos;
opos := MARK (NONE);
IF (vi$beep_position (vi$to_line (vi$active_count), 1, 1) <> 0) THEN
pos := MARK (NONE);
POSITION (opos);
vi$pos_in_middle (pos);
ENDIF;
vi$active_count := 0;
ENDPROCEDURE;
!
! Move to line in file. vi$active_count holds the line number to GO TO.
! If VI$ACTIVE_COUNT is zero, we move to the end of the file.
!
PROCEDURE vi$to_line (cnt)
LOCAL
this_pos, ! Saved position in case of botch
last_line, ! Last line in the buffer
win_len; ! Length of CURRENT_WINDOW
ON_ERROR
vi$info (FAO ("No such line: !SL", VI$ACTIVE_COUNT));
POSITION (this_pos);
cnt := 0;
RETURN;
ENDON_ERROR;
this_pos := MARK(NONE);
POSITION (LINE_BEGIN);
vi$start_pos := MARK (NONE);
IF cnt = 0 THEN
POSITION (END_OF (CURRENT_BUFFER));
ELSE
last_line := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
IF cnt > last_line THEN
IF last_line > 0 THEN
vi$info ("Not that many lines in buffer");
POSITION (this_pos);
RETURN (0);
ENDIF;
ELSE
POSITION (BEGINNING_OF (CURRENT_BUFFER));
win_len := GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH");
MOVE_VERTICAL (cnt - 1);
ENDIF;
ENDIF;
IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
IF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) THEN
vi$new_endpos := MARK (NONE);
ELSE
MOVE_VERTICAL (1);
vi$new_endpos := MARK (NONE);
MOVE_VERTICAL (-1);
ENDIF;
ENDIF;
vi$yank_mode := VI$LINE_MODE;
RETURN (vi$retpos (this_pos));
ENDPROCEDURE;
!
! Set a marker in the current buffer.
!
PROCEDURE vi$_set_mark
LOCAL
mark_char,
mark_name,
key_pressed;
key_pressed := vi$read_a_key;
mark_char := ASCII (key_pressed);
IF (INDEX (vi$_lower_chars, mark_char) <> 0) THEN
mark_name := "vi$mark_" + mark_char;
EXECUTE (COMPILE (mark_name + " := MARK(NONE);"));
ELSE
vi$info ("Invalid marker key!");
ENDIF;
ENDPROCEDURE;
!
! Function mapped to "'" and "`".
!
PROCEDURE vi$_go_to_marker
LOCAL
opos,
pos;
opos := MARK (NONE);
IF (vi$beep_position (vi$to_marker, 1, 1) <> 0) THEN
pos := MARK (NONE);
POSITION (opos);
vi$pos_in_middle (pos);
ENDIF;
ENDPROCEDURE;
!
! Function to move the marker indicated by the next keystroke.
!
PROCEDURE vi$to_marker
LOCAL
mode_key,
pos,
mark_name,
mark_char,
key_pressed;
ON_ERROR;
vi$info ("Mark not set!");
RETURN (0);
ENDON_ERROR;
mode_key := vi$last_key;
key_pressed := vi$read_a_key;
mark_char := ASCII (key_pressed);
IF (INDEX (vi$_lower_chars+"'`", mark_char) = 0) THEN
vi$info ("Invalid marker key!");
RETURN (0);
ENDIF;
pos := MARK (NONE);
IF (key_pressed <> F11) THEN
IF (mark_char = "'") OR (mark_char = "`") THEN
IF (vi$old_place <> 0) THEN
IF (GET_INFO (vi$old_place, "BUFFER") = CURRENT_BUFFER) THEN
POSITION (vi$old_place);
ELSE
vi$info ("Previous place not in this buffer!");
RETURN (0);
ENDIF;
ELSE
vi$info ("No previous mark to return to!");
RETURN (0);
ENDIF;
ELSE
mark_name := "vi$mark_" + mark_char;
EXECUTE (COMPILE ("vi$global_mark := "+mark_name+";"));
IF (vi$global_mark <> 0) AND (GET_INFO (vi$global_mark, "BUFFER") =
CURRENT_BUFFER) THEN
POSITION (vi$global_mark);
vi$yank_mode := VI$LINE_MODE;
ELSE
vi$info ("Invalid mark for this buffer!");
RETURN (0);
ENDIF;
ENDIF;
IF ASCII (mode_key) = "'" THEN
POSITION (LINE_BEGIN);
POSITION (vi$first_no_space (0));
ENDIF;
IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
MOVE_VERTICAL (1);
vi$new_endpos := MARK (NONE);
MOVE_VERTICAL (-1);
ENDIF;
RETURN (vi$retpos (pos));
ENDIF;
POSITION (pos);
RETURN (0);
ENDPROCEDURE;
!
! Maintain the repeat count in vi$active_count. If VI$ACTIVE_COUNT is ZERO,
! and '0' is typed, this means move to beginning of the line.
!
PROCEDURE vi$repeat_count
a IF VI$ACTIVE_COUNT = 0 THEN
vi$active_count := INT (ASCII (KEY_NAME (vi$last_key)));
IF vi$active_count = 0 THEN
vi$beep_position (vi$fol, 0, 1);
ENDIF;
ELSE
vi$active_count := vi$active_count * 10 +
INT (ASCII (KEY_NAME (vi$last_key)));
ENDIF;
ENDPROCEDURE;
!
! The function mapped to <CR>.
!
PROCEDURE vi$_next_line
POSITION (vi$beg_next);
ENDPROCEDURE;
!
! Move the cursor to the beginning of the next line
!
PROCEDURE vi$beg_next
LOCAL
pos;
ON_ERROR
RETURN (MARK (NONE));
ENDON_ERROR;
pos := MARK (NONE);
MOVE_VERTICAL (vi$cur_active_count);
POSITION (LINE_BEGIN);
POSITION (vi$first_no_space (0));
vi$yank_mode := VI$LINE_MODE;
vi$new_offset := 1;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! This function moves to the first non-blank character of a line
!
PROCEDURE vi$first_no_space (use_cur_active)
LOCAL
pos,
t_range;
ON_ERROR
! Ignore string not found messages.
IF ERROR <> TPU$_STRNOTFOUND THEN
POSITION (pos);
RETURN (0);
ENDIF;
ENDON_ERROR;
pos := MARK (NONE);
IF (use_cur_active) THEN
MOVE_VERTICAL (vi$cur_active_count - 1);
ENDIF;
POSITION (LINE_BEGIN);
IF (LENGTH (CURRENT_LINE) > 0) THEN
IF t_range = 0 THEN
t_range :=
SEARCH (ANCHOR & SPAN (vi$no_space) &
NOTANY(vi$no_space), FORWARD);
ENDIF;
IF t_range <> 0 THEN
POSITION (END_OF (t_range));
ELSE
! If that fails, then search for a blank line with extra white
! space, and move to the end of the white space.
t_range := SEARCH (ANCHOR & SPAN (vi$no_space), FORWARD);
IF t_range <> 0 THEN
POSITION (END_OF (t_range));
ENDIF;
ENDIF;
ENDIF;
vi$yank_mode := VI$IN_LINE_MODE;
RETURN (vi$retpos (pos));
ENDPROCEDURE;
!
! Move by a section in the indicated direction
!
PROCEDURE vi$_section (dir)
LOCAL
ch;
ch := vi$read_a_key;
IF ((ASCII(ch) = "]") AND (dir = 1)) OR
((ASCII(ch) = "[") AND (dir = -1)) THEN
vi$beep_position (vi$section (dir), 1, 1);
ELSE
vi$beep;
ENDIF;
ENDPROCEDURE;
!
! Sound a bell.
!
PROCEDURE vi$beep
LOCAL
ln,
pos;
IF (vi$error_bells = 0) THEN
RETURN;
ENDIF;
pos := MARK (NONE);
POSITION (message_buffer);
ln := vi$current_line;
SET (BELL, ALL, ON);
POSITION (pos);
vi$info (ln);
SET (BELL, ALL, OFF);
SET (BELL, BROADCAST, ON);
ENDPROCEDURE;
!
! Mapped to '}' and '{', moves by a paragraph in the indicated direction.
!
PROCEDURE vi$_paragraph(dir)
vi$beep_position (vi$paragraph(dir), 1, 1);
ENDPROCEDURE;
!
! Mapped to ( moves backward a sentence
!
PROCEDURE vi$_begin_sentence
vi$beep_position (vi$begin_sentence, 1, 1);
ENDPROCEDURE;
!
! Mapped to ) moves forward a sentence
!
PROCEDURE vi$_end_sentence
vi$beep_position (vi$end_sentence, 1, 1);
ENDPROCEDURE;
!
! Move backward a sentence.
!
PROCEDURE vi$begin_sentence
LOCAL
rng,
spos,
pos;
ON_ERROR;
ENDON_ERROR;
pos := MARK (NONE);
MOVE_HORIZONTAL (-1);
LOOP;
rng := SEARCH (
(("" | " " | ASCII (9)) & ANY (vi$_upper_chars)),
REVERSE, EXACT);
EXITIF rng = 0;
POSITION (BEGINNING_OF (rng));
IF INDEX (vi$_space_tab, CURRENT_CHARACTER) = 0 THEN
MOVE_HORIZONTAL (-1);
ENDIF;
IF INDEX (vi$_space_tab, CURRENT_CHARACTER) <> 0 THEN
IF (CURRENT_CHARACTER = " ") THEN
MOVE_HORIZONTAL (-1);
IF INDEX (vi$_space_tab, CURRENT_CHARACTER) <> 0 THEN
MOVE_HORIZONTAL (-1);
IF INDEX ("?.!", CURRENT_CHARACTER) <> 0 THEN
MOVE_HORIZONTAL (3);
RETURN (vi$retpos (pos));
ENDIF;
ENDIF;
ELSE
MOVE_HORIZONTAL (1);
RETURN (vi$retpos (pos));
ENDIF;
ENDIF;
POSITION (BEGINNING_OF (rng));
MOVE_HORIZONTAL (-1);
ENDLOOP;
RETURN (0);
ENDPROCEDURE;
!
! Move to next paragraph
!
PROCEDURE vi$paragraph (dir)
RETURN (vi$para_sect (dir, vi$para_pat));
ENDPROCEDURE;
!
! Find next paragraph or section.
!
PROCEDURE vi$para_sect (dir, pat)
LOCAL
loc,
direct,
pos;
pos := MARK (NONE);
IF (dir < 0) THEN
direct := REVERSE;
MOVE_VERTICAL (-1);
ELSE
direct := FORWARD;
MOVE_VERTICAL (1);
ENDIF;
loc := SEARCH (pat, direct, NO_EXACT);
IF (loc <> 0) THEN
RETURN (BEGINNING_OF (loc));
ENDIF;
POSITION (pos);
RETURN (0);
ENDPROCEDURE;
!
! Move to next section
!
PROCEDURE vi$section (dir)
RETURN (vi$para_sect (dir, vi$sect_pat));
ENDPROCEDURE;
!
! Move forward a sentence.
!
PROCEDURE vi$end_sentence
LOCAL
rng,
spos,
pos;
ON_ERROR;
ENDON_ERROR;
pos := MARK (NONE);
MOVE_HORIZONTAL (1);
LOOP;
rng := SEARCH (ANY (vi$_upper_chars), FORWARD, EXACT);
EXITIF rng = 0;
POSITION (BEGINNING_OF (rng));
IF INDEX (vi$_space_tab, CURRENT_CHARACTER) = 0 THEN
MOVE_HORIZONTAL (-1);
ENDIF;
IF INDEX (vi$_space_tab, CURRENT_CHARACTER) <> 0 THEN
IF (CURRENT_CHARACTER = " ") THEN
MOVE_HORIZONTAL (-1);
IF INDEX (vi$_space_tab, CURRENT_CHARACTER) <> 0 THEN
MOVE_HORIZONTAL (-1);
IF INDEX ("?.!", CURRENT_CHARACTER) <> 0 THEN
MOVE_HORIZONTAL (3);
RETURN (vi$retpos (pos));
ENDIF;
ENDIF;
ELSE
MOVE_HORIZONTAL (1);
RETURN (vi$retpos (pos));
ENDIF;
ENDIF;
POSITION (BEGINNING_OF (rng));
MOVE_HORIZONTAL (1);
ENDLOOP;
RETURN (0);
ENDPROCEDURE;
!
! This function returns the value in vi$active count. It takes into
! account that when vi$active_count is zero, it should really be
! one.
!
PROCEDURE vi$cur_active_count
LOCAL
resp,
old_cnt;
old_cnt := vi$active_count;
vi$active_count := 0;
IF old_cnt <= 0 THEN
old_cnt := 1;
ENDIF;
RETURN (old_cnt);
ENDPROCEDURE;
!
! The function mapped to 'p'.
!
PROCEDURE vi$put_after (dest_buf)
LOCAL
source,
pos;
source := vi$cur_text;
IF (GET_INFO (dest_buf, "TYPE") = BUFFER) THEN
source := dest_buf;
ENDIF;
IF (GET_INFO (source, "TYPE") = BUFFER) THEN
pos := MARK (NONE);
POSITION (BEGINNING_OF (source));
vi$yank_mode := INT (vi$current_line);
POSITION (pos);
ENDIF;
IF (source = "") THEN
RETURN;
ENDIF;
IF (vi$yank_mode = VI$LINE_MODE) THEN
IF (MARK(NONE) <> END_OF (CURRENT_BUFFER)) THEN
MOVE_VERTICAL (1);
ENDIF;
ELSE
IF (LENGTH (CURRENT_LINE) > 0) THEN
MOVE_HORIZONTAL (1);
ENDIF;
ENDIF;
vi$put_here (VI$AFTER, source);
ENDPROCEDURE;
!
! The function mapped to 'P'.
!
PROCEDURE vi$put_here (here_or_below, dest_buf)
LOCAL
olen,
source,
pos;
source := vi$cur_text;
olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
IF (GET_INFO (dest_buf, "TYPE") = BUFFER) THEN
source := dest_buf;
ENDIF;
IF (GET_INFO (source, "TYPE") = BUFFER) THEN
pos := MARK (NONE);
POSITION (BEGINNING_OF (source));
IF (MARK (NONE) = END_OF (source)) THEN
RETURN;
ENDIF;
vi$yank_mode := INT (vi$current_line);
ERASE_LINE;
POSITION (pos);
ELSE
IF (source = "") THEN
RETURN;
ENDIF;
ENDIF;
IF source = 0 THEN
vi$info ("Bad buffer for put!");
RETURN;
ENDIF;
IF (vi$yank_mode = VI$LINE_MODE) THEN
POSITION (LINE_BEGIN);
ENDIF;
pos := vi$get_undo_start;
COPY_TEXT (source);
APPEND_LINE;
MOVE_HORIZONTAL (-1);
vi$undo_end := MARK (NONE);
MOVE_HORIZONTAL (1);
vi$kill_undo;
IF (here_or_below = VI$AFTER) AND (vi$yank_mode = VI$LINE_MODE) THEN
POSITION (LINE_BEGIN);
ENDIF;
vi$undo_start := vi$set_undo_start (pos);
! Put the mode back into the buffer.
IF (GET_INFO (source, "TYPE") = BUFFER) THEN
POSITION (BEGINNING_OF (source));
COPY_TEXT (STR (vi$yank_mode));
SPLIT_LINE;
POSITION (vi$undo_start);
ENDIF;
IF (here_or_below = VI$AFTER) AND (vi$yank_mode = VI$IN_LINE_MODE) THEN
POSITION (vi$undo_end);
ENDIF;
vi$check_length (olen);
ENDPROCEDURE;
!
! Function mapped to 'o'.
!
PROCEDURE vi$open_below
LOCAL
uline;
ON_ERROR
! Ignore attempt to move past EOB errors
ENDON_ERROR;
uline := vi$cur_line_no;
MOVE_VERTICAL (1);
vi$open_here;
vi$undo_line := uline;
ENDPROCEDURE;
!
! Function mapped to 'O'
!
PROCEDURE vi$open_here
LOCAL
uline,
offs,
cnt,
epos,
spos;
uline := vi$cur_line_no;
offs := CURRENT_OFFSET;
POSITION (LINE_BEGIN);
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (-1);
spos := MARK (NONE);
MOVE_HORIZONTAL (1);
ELSE
spos := 0;
ENDIF;
SPLIT_LINE;
MOVE_VERTICAL (-1);
cnt := vi$while_not_esc;
IF (cnt <> 0) THEN
IF (LENGTH(vi$current_line) > 0) THEN
MOVE_HORIZONTAL (1);
ENDIF;
ENDIF;
epos := MARK (NONE);
vi$undo_end := MARK (NONE);
vi$undo_start := vi$set_undo_start (spos);
POSITION (epos);
vi$kill_undo;
vi$undo_line := uline;
vi$undo_offset := offs;
ENDPROCEDURE;
!
! This function guards the right margin, and the end of the buffer so
! that the cursor never is displayed past those boundries.
!
PROCEDURE vi$check_rmarg
ON_ERROR;
! ignore "Can't return line and end of buffer" messages
RETURN;
ENDON_ERROR;
IF (LENGTH (vi$current_line) > 0) THEN
IF (CURRENT_OFFSET = LENGTH (vi$current_line)) THEN
MOVE_HORIZONTAL (-1);
ENDIF;
ENDIF;
IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
MOVE_VERTICAL (-1);
ENDIF;
ENDPROCEDURE;
!
! The function mapped to 'h'.
!
PROCEDURE vi$move_left
vi$beep_position (vi$left, 0, 1);
ENDPROCEDURE;
!
! The function mapped to 'l'.
!
PROCEDURE vi$move_right
vi$beep_position (vi$right, 0, 1);
ENDPROCEDURE;
!
! The function mapped to 'j'
!
PROCEDURE vi$move_down
LOCAL
save_mark;
save_mark := 0;
IF (vi$active_count >= vi$report) THEN
save_mark := 1;
ENDIF;
vi$beep_position (vi$downline (0), save_mark, 1);
ENDPROCEDURE;
!
! The function mapped to 'k'.
!
PROCEDURE vi$move_up
LOCAL
save_mark;
save_mark := 0;
IF (vi$active_count >= vi$report) THEN
save_mark := 1;
ENDIF;
vi$beep_position (vi$upline, save_mark, 1);
ENDPROCEDURE;
!
! The function mapped to 'i'.
!
PROCEDURE vi$insert_here
LOCAL
act_cnt,
rnge,
ccnt,
epos,
spos;
vi$kill_undo;
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (-1);
spos := MARK (NONE);
MOVE_HORIZONTAL (1);
ELSE
spos := 0;
ENDIF;
vi$undo_start := MARK (NONE);
ccnt := vi$while_not_esc;
vi$undo_end := 0;
IF (ccnt > 0) THEN
epos := MARK (NONE);
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (1);
ENDIF;
ELSE
epos := 0;
IF (CURRENT_OFFSET <> 0) THEN
MOVE_HORIZONTAL (-1);
ENDIF;
ENDIF;
act_cnt := vi$cur_active_count;
IF epos <> 0 THEN
IF spos <> 0 THEN
POSITION (spos);
MOVE_HORIZONTAL (1);
ELSE
POSITION (BEGINNING_OF (CURRENT_BUFFER));
ENDIF;
vi$undo_start := MARK (NONE);
POSITION (epos);
IF (vi$undo_start = 0) OR (epos = 0) THEN
vi$info ("Ooops, bad markers in vi$insert_here");
RETURN ;
ENDIF;
rnge := CREATE_RANGE (vi$undo_start, epos, NONE);
LOOP
EXITIF act_cnt < 2;
MOVE_HORIZONTAL (1);
IF rnge = 0 THEN
vi$info ("Ooops, generated a bad range in vi$insert_here");
RETURN ;
ENDIF;
COPY_TEXT (rnge);
act_cnt := act_cnt - 1;
MOVE_HORIZONTAL (-1);
ENDLOOP;
vi$undo_end := MARK (NONE);
IF (CURRENT_OFFSET = LENGTH (vi$current_line)) THEN
MOVE_HORIZONTAL (1);
ENDIF;
ENDIF;
ENDPROCEDURE;
!
! The function mapped to 'I'
!
PROCEDURE vi$insert_at_begin
POSITION (LINE_BEGIN);
vi$_bol (0);
vi$insert_here;
ENDPROCEDURE;
!
! The function mapped to 'a'
!
PROCEDURE vi$insert_after
LOCAL
cline,
$$EOD$$
More information about the Comp.sources.misc
mailing list