gregg@a.cs.okstate.edu@mandrill.CWRU.Edu (Gregg Wonderly) (10/13/87)
$ WRITE SYS$OUTPUT "Creating ""VI.8"""
$ CREATE VI.8
$ DECK/DOLLARS=$$EOD$$
POSITION (pos);
DELETE (buf);
vi$message ("Key now unmapped!");
ENDPROCEDURE;
!
! Show current keyboard mappings.
!
PROCEDURE vi$show_maps
LOCAL
com,
key_type,
keyn,
key,
bpos,
npos,
pos,
buf;
pos := MARK (NONE);
buf := choice_buffer;
POSITION (buf);
ERASE (buf);
key_type := vi$cmd_keys;
COPY_TEXT ("COMMAND KEY MAPS:");
SPLIT_LINE;
LOOP
keyn := GET_INFO (DEFINED_KEY, "first", key_type);
LOOP
EXITIF (keyn = 0);
com := LOOKUP_KEY (keyn, COMMENT, key_type);
IF (com = "active_macro") THEN
key := vi$key_map_name (keyn);
vi$global_var := 0;
EXECUTE (COMPILE ("vi$global_var:=vi$$key_map_buf_"+
key+key_type));
IF (vi$global_var <> 0) AND
(GET_INFO (vi$global_var, "TYPE") = BUFFER) THEN
key := vi$ascii_name (keyn);
COPY_TEXT (" "+key+SUBSTR (" ", 1, 4-LENGTH(key))+'"');
npos := MARK (NONE);
POSITION (BEGINNING_OF (vi$global_var));
LOOP
keyn := CURRENT_LINE;
EXITIF (LENGTH (keyn) < 8);
bpos := MARK (NONE);
POSITION (npos);
COPY_TEXT (vi$ascii_name (INT(keyn)));
POSITION (bpos);
MOVE_VERTICAL (1);
ENDLOOP;
POSITION (npos);
COPY_TEXT ('"');
SPLIT_LINE;
ENDIF;
ENDIF;
keyn := GET_INFO (DEFINED_KEY, "next", key_type);
ENDLOOP;
EXITIF (key_type = vi$edit_keys);
key_type := vi$edit_keys;
SPLIT_LINE;
COPY_TEXT ("EDITING KEY MAPS:");
SPLIT_LINE;
ENDLOOP;
APPEND_LINE;
POSITION (BEGINNING_OF (buf));
POSITION (pos);
vi$show_list (buf,
" Current MAPPINGS" +
" ",
info_window);
RETURN (0);
ENDPROCEDURE;
!
! Generate a unique string based on a KEY_NAME value.
!
PROCEDURE vi$key_map_name (key)
RETURN (SUBSTR(FAO("!XL", key),1,6));
ENDPROCEDURE;
!
! Increment "i" until it is no longer indexing a blank or tab in "cmd".
!
PROCEDURE vi$skip_white (cmd, i)
LOOP
EXITIF i > LENGTH (cmd);
EXITIF (INDEX (" ", SUBSTR(cmd, i, 1)) = 0);
i := i + 1;
ENDLOOP;
ENDPROCEDURE;
!
! Given a string, extract a line specification that is either absolute,
! relative, or an RE pattern expression.
!
PROCEDURE vi$get_line_spec (idx, cmd)
LOCAL
ch,
sch,
num;
num := -1;
ch := SUBSTR (cmd, idx, 1);
IF (ch = "/") OR (ch = "?") THEN
idx := idx + 1;
sch := ch;
num := "";
LOOP
EXITIF (vi$parse_next_ch (idx, cmd, sch));
EXITIF (LENGTH (cmd) < idx);
ch := SUBSTR (cmd, idx, 1);
IF (ch = "\") THEN
num := num + SUBSTR (cmd, idx, 2);
idx := idx + 1;
ELSE
num := num + ch;
ENDIF;
idx := idx + 1;
ENDLOOP;
IF (LENGTH (cmd) < idx - 1) THEN
MESSAGE ("Oops, improper expression!");
RETURN (-1);
ENDIF;
ch := SUBSTR (cmd, idx, 1);
IF sch = "?" THEN
SET (REVERSE, CURRENT_BUFFER);
ELSE
SET (FORWARD, CURRENT_BUFFER);
ENDIF;
num := vi$find_str (num, 0);
IF (num <> 0) THEN
num := BEGINNING_OF (num);
POSITION (num);
num := vi$cur_line_no;
ELSE
num := -1;
ENDIF;
ELSE
LOOP
ch := SUBSTR (cmd, idx, 1);
EXITIF (INDEX (vi$_numeric_chars, ch) = 0);
IF (num < 0) THEN
num := INT (ch);
ELSE
num := num * 10 + INT (ch);
ENDIF;
idx := idx + 1;
ENDLOOP;
ENDIF;
IF (ch = ".") THEN
num := vi$cur_line_no;
idx := idx + 1;
IF (vi$parse_next_ch (idx, cmd, "+")) THEN
num := num + vi$get_line_spec (idx, cmd);
ENDIF;
ELSE
IF (ch = "$") THEN
num := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
idx := idx + 1;
ELSE
IF (ch = "+") THEN
num := num + vi$get_line_spec (idx, cmd);
ENDIF;
ENDIF;
ENDIF;
RETURN (num);
ENDPROCEDURE;
!
! If the character at location "idx" in "cmd" is "try", then increment
! "idx" and return TRUE, otherwise return FALSE.
!
PROCEDURE vi$parse_next_ch (idx, cmd, try)
IF (SUBSTR (cmd, idx, 1) = try) THEN
idx := idx + 1;
RETURN (1);
ENDIF;
RETURN (0);
ENDPROCEDURE;
!
! A function to get the string, in "cmd", that is spanned by the characters
! in "mask". "idx" is incremented to point past this string, and the string
! is returned as the function value.
!
PROCEDURE vi$get_cmd_token (mask, cmd, idx)
LOCAL
token,
ch;
token := "";
vi$skip_white (cmd, idx);
LOOP
EXITIF (idx > LENGTH (cmd));
ch := SUBSTR (cmd, idx, 1);
EXITIF (INDEX (mask, ch) = 0);
token := token + ch;
idx := idx + 1;
ENDLOOP;
RETURN (token);
ENDPROCEDURE;
!
! A function to see if the string "token" is a lead substring of "cmd".
!
PROCEDURE vi$leading_str (token, cmd)
RETURN ((token <> "") AND (INDEX (cmd, token) = 1));
ENDPROCEDURE;
!
! A routine that looks for the first occurance of a character in
! "seps", in "cmd", and then changes "idx" to reflect that locatation.
! "separ" will contain the character in "seps" that was actually found.
!
PROCEDURE vi$skip_separ (cmd, idx, seps, separ)
LOCAL
nch,
retstr;
retstr := "";
separ := "";
vi$skip_white (cmd, idx);
LOOP
EXITIF (idx > LENGTH (cmd));
nch := SUBSTR (cmd, idx, 1);
idx := idx + 1;
IF (INDEX (seps, nch) <> 0) OR (nch = " ") OR (nch = " ") THEN
separ := nch;
RETURN (retstr);
ENDIF;
retstr := retstr + nch;
ENDLOOP;
RETURN (retstr);
ENDPROCEDURE;
!
! A procedure that returns the characters occuring at index, "idx", and
! after in the string "cmd".
!
PROCEDURE vi$rest_of_line (cmd, idx)
RETURN (SUBSTR (cmd, idx, LENGTH (cmd)-idx + 1));
ENDPROCEDURE;
!
! SET (INFORMATIONAL/SUCCESS) short procedures.
!
PROCEDURE vi$info_success_off vi$info_off; vi$success_off; ENDPROCEDURE;
PROCEDURE vi$info_success_on vi$info_on; vi$success_on; ENDPROCEDURE;
PROCEDURE vi$success_off SET (SUCCESS, OFF); ENDPROCEDURE;
PROCEDURE vi$success_on SET (SUCCESS, ON); ENDPROCEDURE;
PROCEDURE vi$info_off SET (INFORMATIONAL, OFF); ENDPROCEDURE;
PROCEDURE vi$info_on SET (INFORMATIONAL, ON); ENDPROCEDURE;
!
! Called from vi$do_global to perform a substitution during a global command.
!
PROCEDURE vi$global_subs (cmd, nsubs)
LOCAL
idx,
result_text,
replace_text,
hrange,
ch,
pos,
spos,
epos,
lpos,
source,
scount,
dest,
query,
global,
replace,
separ;
idx := 1;
separ := vi$next_char (cmd, idx);
source := "";
dest := "";
global := 0;
query := 0;
LOOP
IF (idx > LENGTH (cmd)) THEN
vi$message ("Insufficent arguments!");
RETURN (0);
ENDIF;
ch := SUBSTR (cmd, idx, 1);
EXITIF ch = separ;
source := source + ch;
idx := idx + 1;
ENDLOOP;
idx := idx + 1;
LOOP
EXITIF idx > LENGTH (cmd);
ch := SUBSTR (cmd, idx, 1);
EXITIF ch = separ;
dest := dest + ch;
idx := idx + 1;
ENDLOOP;
idx := idx + 1;
LOOP
EXITIF idx > LENGTH (cmd);
ch := SUBSTR (cmd, idx, 1);
IF ch = "q" THEN
query := 1;
ELSE
IF ch = "g" THEN
global := 1;
ELSE
vi$message ("Unrecognized command qualifier '"+ch+"'");
RETURN (0);
ENDIF;
ENDIF;
idx := idx + 1;
ENDLOOP;
vi$replace_source := source;
vi$replace_dest := dest;
lpos := vi$perform_subs (source, dest, vi$cur_line_no,
scount, global, query);
nsubs := nsubs + scount;
RETURN (lpos);
ENDPROCEDURE;
!
! Called from vi$do_command to parse the rest of the command line,
! this procedure then envokes lower level routines to perform the work
! of a substitution command.
!
PROCEDURE vi$do_substitute (start_line, end_line, whole_range, idx, cmd)
LOCAL
result_text,
replace_text,
hrange,
ch,
pos,
spos,
epos,
lpos,
source,
scount,
dest,
query,
global,
replace,
separ;
pos := MARK (NONE);
POSITION (END_OF (whole_range));
epos := MARK (NONE);
POSITION (pos);
separ := vi$next_char (cmd, idx);
vi$replace_separ := separ;
source := "";
dest := "";
global := 0;
query := 0;
MESSAGE ("");
LOOP
IF (idx > LENGTH (cmd)) THEN
vi$message ("Insufficent arguments!");
RETURN (1);
ENDIF;
ch := SUBSTR (cmd, idx, 1);
EXITIF ch = separ;
source := source + ch;
idx := idx + 1;
ENDLOOP;
idx := idx + 1;
LOOP
EXITIF idx > LENGTH (cmd);
ch := SUBSTR (cmd, idx, 1);
EXITIF ch = separ;
dest := dest + ch;
idx := idx + 1;
ENDLOOP;
idx := idx + 1;
LOOP
EXITIF idx > LENGTH (cmd);
ch := SUBSTR (cmd, idx, 1);
IF ch = "q" THEN
query := 1;
ELSE
IF ch = "g" THEN
global := 1;
ELSE
vi$message ("Unrecognized command qualifier '"+ch+"'");
RETURN (1);
ENDIF;
ENDIF;
idx := idx + 1;
ENDLOOP;
POSITION (pos);
vi$save_for_undo (whole_range, VI$LINE_MODE, 1);
vi$move_to_line (start_line);
IF MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER) THEN
MOVE_HORIZONTAL (-1);
spos := MARK (NONE);
MOVE_HORIZONTAL (1);
ELSE
spos := 0;
ENDIF;
vi$replace_source := source;
vi$replace_dest := dest;
lpos := vi$perform_subs (source, dest, end_line, scount, global, query);
IF (scount = 0) THEN
vi$kill_undo;
vi$undo_end := 0;
POSITION (pos);
ELSE
vi$undo_end := epos;
IF (spos = 0) THEN
vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
ELSE
POSITION (spos);
MOVE_HORIZONTAL (1);
vi$undo_start := MARK (NONE);
ENDIF;
vi$pos_in_middle (lpos);
MESSAGE (FAO ("!UL substitution!%S!", scount));
ENDIF;
RETURN (1);
ENDPROCEDURE;
!
! Repeat the last substitute command that was issued at the ":" prompt.
!
! The function mapped to '&'.
!
PROCEDURE vi$repeat_subs
LOCAL
scount,
global,
query,
lpos,
spos,
pos,
epos,
here;
IF (vi$replace_separ = 0) THEN
vi$message ("No previous substitution!");
RETURN;
ENDIF;
global := 0;
query := 0;
here := vi$cur_line_no;
vi$save_for_undo (CURRENT_LINE, VI$LINE_MODE, 1);
pos := MARK (NONE);
MOVE_HORIZONTAL (-CURRENT_OFFSET);
spos := vi$get_undo_start;
MOVE_HORIZONTAL (LENGTH (CURRENT_LINE));
IF (LENGTH (CURRENT_LINE) > 0) THEN
MOVE_HORIZONTAL (-1);
ENDIF;
epos := MARK (NONE);
POSITION (pos);
lpos := vi$perform_subs (vi$replace_source, vi$replace_dest,
here, scount, global, query);
IF (scount = 0) THEN
vi$kill_undo;
vi$undo_end := 0;
ELSE
vi$undo_end := epos;
vi$undo_start := vi$set_undo_start (spos);
POSITION (lpos);
ENDIF;
ENDPROCEDURE;
!
! Perform a substitution from the current location to "end_line".
! Use source as the search string, and dest as the substitution
! spec. "global" indicates whether or not all occurances on a line
! are examined, and "query" indicates whether or not to prompt before
! performing the substitution. On return, "scount" will hold the
! number of substitutions actually performed.
!
PROCEDURE vi$perform_subs (source, dest, end_line, scount, global, query)
LOCAL
result_text,
replace_text,
answer,
fcnt,
lpos,
hrange,
replace,
fpos,
quit_now,
cwin,
pos;
SET (FORWARD, CURRENT_BUFFER);
scount := 0;
fcnt := 0;
quit_now := 0;
pos := MARK (NONE);
LOOP
fpos := vi$find_str (source, 1);
EXITIF (fpos = 0);
fcnt := fcnt + 1;
POSITION (BEGINNING_OF (fpos));
IF vi$cur_line_no > end_line THEN
POSITION (pos);
EXITIF (1);
ENDIF;
result_text := SUBSTR (fpos, 1, LENGTH (fpos));
replace_text := vi$substitution (result_text, dest);
POSITION (BEGINNING_OF (fpos));
replace := 1;
IF (query) THEN
POSITION (BEGINNING_OF (fpos));
hrange := CREATE_RANGE (BEGINNING_OF (fpos),
END_OF (fpos), REVERSE);
cwin := GET_INFO (WINDOWS, "FIRST");
LOOP
EXITIF (cwin = 0);
IF (GET_INFO (cwin, "VISIBLE")) THEN
UPDATE (cwin);
ENDIF;
cwin := GET_INFO (WINDOWS, "NEXT");
ENDLOOP;
answer := vi$read_line ("Replace y/n/a/q? ");
CHANGE_CASE (answer, LOWER);
IF (answer = "") OR (INDEX ("yes", answer) <> 1) THEN
replace := 0;
ENDIF;
IF (INDEX ("quit", answer) = 1) THEN
quit_now := 1;
ENDIF;
IF (INDEX ("all", answer) = 1) THEN
query := 0;
ENDIF;
ENDIF;
IF replace THEN
! This is a hack necessary to fix TPU's pattern matching.
! The length of the text match by only "line_begin" has
! length == 1 instead of 0 as one would expect.
IF (source <> "^") THEN
ERASE_CHARACTER (LENGTH (result_text));
ENDIF;
COPY_TEXT (replace_text);
pos := MARK (NONE);
scount := scount + 1;
ELSE
MOVE_HORIZONTAL (1);
ENDIF;
IF NOT global THEN
MOVE_HORIZONTAL (-CURRENT_OFFSET);
EXITIF MARK (NONE) = END_OF (CURRENT_BUFFER);
MOVE_VERTICAL (1);
ENDIF;
EXITIF quit_now;
ENDLOOP;
IF fcnt = 0 THEN
MESSAGE ("string not found!");
ENDIF;
RETURN (pos);
ENDPROCEDURE;
!
! Move horizontal, ignoring errors
!
PROCEDURE vi$move_horizontal (cnt)
ON_ERROR
ENDON_ERROR;
MOVE_HORIZONTAL (cnt);
ENDPROCEDURE;
!
! Move vertical, ignoring errors
!
PROCEDURE vi$move_vertical (cnt)
ON_ERROR
ENDON_ERROR;
MOVE_VERTICAL (cnt);
ENDPROCEDURE;
!
! Move to the indicated line number.
!
PROCEDURE vi$move_to_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 (MARK (NONE));
ENDPROCEDURE;
!
! Give a source string, and a "dest" substitution spec, perform the
! RE style substitution, and return the resultant string.
!
PROCEDURE vi$substitution (source, dest)
LOCAL
cur_char,
result,
idx;
idx := 0;
result := "";
LOOP
EXITIF (idx > LENGTH(dest));
cur_char := SUBSTR (dest, idx, 1);
IF (cur_char = "&") THEN
result := result + source;
idx := idx + 1;
ELSE
IF (cur_char = '\') THEN
cur_char := SUBSTR(dest, idx+1, 1);
IF (INDEX ("123456789", cur_char) > 0) THEN
IF INT(cur_char) > 1 THEN
EXECUTE (COMPILE ("vi$glo_str := SUBSTR (p" +
cur_char +", LENGTH (o"+cur_char+")+1,512);"));
ELSE
EXECUTE (COMPILE ("vi$glo_str := SUBSTR (p" +
cur_char +", LENGTH (o"+cur_char+"),512);"));
ENDIF;
result := result + vi$glo_str;
ELSE
result := result + "\" + cur_char;
ENDIF;
idx := idx + 2;
ELSE
result := result + cur_char;
idx := idx + 1;
ENDIF;
ENDIF;
ENDLOOP;
RETURN (result);
ENDPROCEDURE;
!
! Get the next character from a string at idx, and point past the character
!
PROCEDURE vi$next_char (cmd, idx)
IF idx <= LENGTH (cmd) THEN
idx := idx + 1;
RETURN (SUBSTR (cmd, idx -1, 1));
ENDIF;
RETURN ("");
ENDPROCEDURE;
!
! Process all set commands in the string cmd
!
PROCEDURE vi$set_commands (cmd, i)
LOCAL
err,
separ,
token_1;
ON_ERROR
RETURN;
ENDON_ERROR;
LOOP
token_1 := vi$skip_separ (cmd, i, "= ", separ);
EDIT (token_1, COLLAPSE);
EXITIF token_1 = "";
err := vi$set_one (token_1, separ, cmd, i);
EXITIF err;
ENDLOOP;
RETURN (err);
ENDPROCEDURE
!
! Process a single set command and return success or failure.
!
PROCEDURE vi$set_one (token_1, separ, cmd, i)
LOCAL
val,
errno,
curwin,
curbuf,
buf,
use_fortran,
oldscrlen,
npat,
pstr,
token_2;
ON_ERROR
errno := ERROR;
MESSAGE ("ERROR at line: "+STR(ERROR_LINE)+", "+
call_user(vi$cu_getmsg,STR(errno)));
RETURN (1);
ENDON_ERROR;
token_2 := "";
IF (token_1 = "all") THEN
vi$show_settings;
RETURN (0);
ENDIF;
IF (token_1 = "tags") THEN
vi$tag_files := vi$rest_of_line (cmd, i);
i := LENGTH (cmd) + 1;
RETURN (vi$load_tags);
ENDIF;
IF (token_1 = "notagcase") OR (token_1 = "notc") THEN
vi$tag_case := NO_EXACT;
RETURN (0);
ENDIF;
IF (token_1 = "tagcase") OR (token_1 = "tc") THEN
vi$tag_case := EXACT;
RETURN (0);
ENDIF;
IF (token_1 = "senddcl") THEN
vi$send_dcl := 1;
RETURN (0);
ENDIF;
IF (token_1 = "nosenddcl") THEN
vi$send_dcl := 0;
RETURN (0);
ENDIF;
IF (token_1 = "files") OR (token_1 = "file") THEN
val := vi$expand_file_list (vi$rest_of_line (cmd, i));
MESSAGE (FAO ("!UL file!%S selected", val, 0));
RETURN (2);
ENDIF;
IF (token_1 = "notabs") THEN
vi$use_tabs := 0;
RETURN (0);
ENDIF;
IF (token_1 = "tabs") THEN
vi$use_tabs := 1;
RETURN (0);
ENDIF;
IF (token_1 = "write") OR (token_1 = "wr") THEN
SET (NO_WRITE, CURRENT_BUFFER, OFF);
vi$status_lines (CURRENT_BUFFER);
RETURN (0);
ENDIF;
IF (token_1 = "nowrite") OR (token_1 = "nowr") THEN
SET (NO_WRITE, CURRENT_BUFFER, ON);
vi$status_lines (CURRENT_BUFFER);
RETURN (0);
ENDIF;
IF (token_1 = "width") THEN
token_2 := vi$skip_separ (cmd, i, "= ", separ);
val := INT (token_2);
SET (WIDTH, CURRENT_WINDOW, val);
vi$scr_width := val;
RETURN (0);
ENDIF;
IF (token_1 = "window") THEN
token_2 := vi$skip_separ (cmd, i, "= ", separ);
val := INT (token_2);
RETURN (vi$do_set_window (val));
ENDIF;
IF (token_1 = "ts") OR (token_1 = "tabstops") THEN
token_2 := vi$skip_separ (cmd, i, "= ", separ);
val := INT (token_2);
SET (TAB_STOPS, CURRENT_BUFFER, val);
vi$tab_amount := val;
RETURN (0);
ENDIF;
IF (token_1 = "sw") OR (token_1 = "shiftwidth") then
token_2 := vi$skip_separ (cmd, i, "= ", separ);
vi$shift_width := INT (token_2);
RETURN (0);
ENDIF;
IF (token_1 = "noundomap") OR (token_1 = "noum") THEN
vi$undo_map := 0;
RETURN (0);
ENDIF;
IF (token_1 = "undomap") OR (token_1 = "um") THEN
vi$undo_map := 1;
RETURN (0);
ENDIF;
IF (token_1 = "scroll") THEN
token_2 := vi$skip_separ (cmd, i, "= ", separ);
vi$how_much_scroll := INT (token_2);
RETURN (0);
ENDIF;
IF (token_1 = "report") THEN
token_2 := vi$skip_separ (cmd, i, "= ", separ);
vi$report := INT (token_2);
RETURN (0);
ENDIF;
IF (token_1 = "aw") OR (token_1 = "autowrite") THEN
vi$auto_write := 1;
RETURN (0);
ENDIF;
IF (token_1 = "noaw") OR (token_1 = "noautowrite") THEN
vi$auto_write := 0;
RETURN (0);
ENDIF;
IF (token_1 = "noic") OR (token_1 = "noignorecase") THEN
vi$ignore_case := EXACT;
RETURN (0);
ENDIF;
IF (token_1 = "ic") OR (token_1 = "ignorecase") THEN
vi$ignore_case := NO_EXACT;
RETURN (0);
ENDIF;
IF (token_1 = "magic") THEN
vi$magic := 1;
RETURN (0);
ENDIF;
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, "= ", separ);
vi$wrap_margin := INT (token_2);
RETURN (0);
ENDIF;
vi$para_str := "P p ";
vi$para_pat := line_begin & (
(".P" | ".p") |
(LINE_END));
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 + "))";
ELSE
pstr := '""&'+pstr;
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 + ")";
EXECUTE (COMPILE ("vi$para_pat:="+pstr+";"));
RETURN (0);
ENDIF;
IF (token_1 = "number") OR
(token_1 = "optimize") OR
(token_1 = "autoindent") OR
(token_1 = "noautoprint") OR
(token_1 = "novice") OR
(token_1 = "slowopen") 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 = "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 = "shell") OR
(token_1 = "mesg") OR
(token_1 = "nomesg") OR
(token_1 = "showmatch") THEN
vi$not_implemented (token_1);
RETURN (1);
ENDIF;
vi$message ("Unrecognized option, 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
MESSAGE (
"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
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;
COPY_TEXT (FAO (
"!20<!ASshowmode!>",
SUBSTR ("no", 1, (1-vi$show_mode)*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;
!
! Function to say that a particular command is not implemented.
!
PROCEDURE vi$not_implemented (cmd)
vi$message (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$position (vi$to_char (char_val), 0);
ENDPROCEDURE;
!
! Function performing task for 't'.
!
PROCEDURE vi$to_char (char_to_find)
LOCAL
act_count,
pos,
found;
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;
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$position (vi$back_to_char (char_val), 0);
ENDPROCEDURE;
!
! Function performing task for 'T'.
!
PROCEDURE vi$back_to_char (char_to_find)
LOCAL
act_count,
pos,
found;
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$position (vi$find_char (char_val), 0);
ENDPROCEDURE;
!
! Function performing task for 'f'.
!
PROCEDURE vi$find_char (char_to_find)
LOCAL
act_count,
pos,
found;
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$position (vi$back_find_char (char_val), 0);
ENDPROCEDURE;
!
! Function performing task for 'F'.
!
PROCEDURE vi$back_find_char (char_to_find)
LOCAL
act_count,
pos,
found;
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
vi$position (vi$to_line (vi$active_count), 1);
vi$pos_in_middle (MARK (NONE));
$$EOD$$