gregg@a.cs.okstate.edu@mandrill.CWRU.Edu (Gregg Wonderly) (10/13/87)
$ WRITE SYS$OUTPUT "Creating ""VI.7"""
$ CREATE VI.7
$ DECK/DOLLARS=$$EOD$$
RETURN (1);
ENDIF;
ENDIF;
ENDLOOP;
IF cmd_str <> "d" THEN
MESSAGE (STR (nsubs) + " substitutions.");
ENDIF;
vi$undo_end := END_OF (CURRENT_BUFFER);
vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
vi$check_length (olen);
RETURN (1);
ENDPROCEDURE;
!
! Change the current working directory to the string given. A simple
! effort is made to translate the string given, but no other effort is
! made to decode the actual logicals emmbeded in the string.
!
PROCEDURE vi$do_cd (cmd, i)
LOCAL
old_dir,
sysdisk,
retval,
orig_nam,
colon,
directory_name;
ON_ERROR
ENDON_ERROR;
vi$skip_white (cmd, i);
directory_name := vi$rest_of_line (cmd, i);
orig_nam := directory_name;
directory_name := CALL_USER (vi$cu_trnlnm_proc, orig_nam);
IF (directory_name = "") THEN
directory_name := CALL_USER (vi$cu_trnlnm_job, orig_nam);
IF (directory_name = "") THEN
directory_name := CALL_USER (vi$cu_trnlnm_group, orig_nam);
IF (directory_name = "") THEN
directory_name := CALL_USER (vi$cu_trnlnm_sys, orig_nam);
ENDIF;
ENDIF;
ENDIF;
IF (directory_name = "") THEN
directory_name := orig_nam;
ENDIF;
colon := INDEX (directory_name, ":");
sysdisk := CALL_USER (vi$cu_trnlnm_proc, "SYS$DISK");
IF (colon <> 0) THEN
sysdisk := SUBSTR (directory_name, 1, colon);
directory_name := SUBSTR (directory_name, colon+1, 255);
EDIT (sysdisk, UPPER,COLLAPSE);
retval := CALL_USER (vi$cu_set_sysdisk, sysdisk);
ENDIF;
TRANSLATE (directory_name, " ", "[]");
EDIT (directory_name, UPPER,COLLAPSE);
directory_name := '[' + directory_name + ']';
old_dir := CALL_USER (vi$cu_cwd, directory_name);
MESSAGE ("New directory is " + CALL_USER (vi$cu_trnlnm_proc, "SYS$DISK") +
CALL_USER (vi$cu_cwd, ""));
RETURN (1);
ENDPROCEDURE;
!
! The show command...
!
PROCEDURE vi$do_show (cmd, i)
LOCAL
act;
vi$skip_white (cmd, i);
act := vi$rest_of_line (cmd, i);
CHANGE_CASE (act, LOWER);
IF (vi$leading_str (act, "files")) THEN
vi$_show_files;
ELSE
IF (vi$leading_str (act, "buffers")) THEN
vi$_show_buffers;
ELSE
IF (vi$leading_str (act, "tags")) THEN
vi$_show_tags;
ENDIF;
ENDIF;
ENDIF;
RETURN (0);
ENDPROCEDURE;
!
! Show the current list of abbreviations that are known
!
PROCEDURE vi$show_abbrevs
LOCAL
buf,
loc,
varn,
rvar,
i,
idx,
ch,
strg,
vars,
errno,
pos;
ON_ERROR
errno := ERROR;
IF (errno <> TPU$_MULTIPLENAMES) AND
(errno <> TPU$_STRNOTFOUND) THEN
MESSAGE (CALL_USER (vi$cu_getmsg, STR(errno)));
POSITION (pos);
RETURN;
ENDIF;
ENDON_ERROR;
pos := MARK (NONE);
buf := choice_buffer;
ERASE (buf);
vars := EXPAND_NAME ("VI$ABBR_", VARIABLES);
IF (vars = "") THEN
MESSAGE ("Humm, there are not any abbreviations!");
RETURN (1);
ENDIF;
POSITION (buf);
COPY_TEXT (vars);
POSITION (BEGINNING_OF (buf));
LOOP
loc := SEARCH (" ", FORWARD, EXACT);
EXITIF loc = 0;
POSITION (BEGINNING_OF (loc));
ERASE_CHARACTER (1);
SPLIT_LINE;
ENDLOOP;
POSITION (BEGINNING_OF (buf));
LOOP
EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
IF (CURRENT_LINE = "VI$ABBR_") THEN
ERASE_LINE;
ELSE
vi$global_var := 0;
EXECUTE (COMPILE ("vi$global_var := "+CURRENT_LINE));
varn := SUBSTR (CURRENT_LINE, 9, 500);
rvar := "";
idx := 1;
LOOP
EXITIF (vi$global_var = 0);
EXITIF (idx > LENGTH (VARN));
ch := SUBSTR (VARN, idx, 1);
IF (ch = "_") THEN
ch := SUBSTR (VARN, idx+1, 1);
IF (INDEX (vi$_upper_chars+"_", ch) <> 0) THEN
rvar := rvar + ch;
ELSE
EDIT (ch, LOWER);
rvar := rvar + ch;
ENDIF;
idx := idx + 1;
ELSE
EDIT (ch, LOWER);
rvar := rvar + ch;
ENDIF;
idx := idx + 1;
ENDLOOP;
ERASE_LINE;
IF (vi$global_var <> 0) THEN
strg := FAO ("!20AS = ""!AS""", rvar, vi$global_var);
COPY_TEXT (strg);
SPLIT_LINE;
ENDIF;
ENDIF;
ENDLOOP;
POSITION (BEGINNING_OF (buf));
POSITION (pos);
vi$show_list (buf,
" Current Abbreviations" +
" ",
info_window);
RETURN (0);
ENDPROCEDURE;
!
! Show the current buffers and their attributes
!
PROCEDURE vi$_show_buffers
LOCAL
mod,
nr,
sys,
pos,
buf,
bn;
buf := GET_INFO (BUFFERS, "FIRST");
ERASE (choice_buffer);
pos := MARK (NONE);
POSITION (choice_buffer);
LOOP
LOOP
EXITIF (buf = 0);
EXITIF (GET_INFO (buf, "SYSTEM") = 0);
buf := GET_INFO (BUFFERS, "NEXT");
ENDLOOP;
EXITIF (buf = 0);
mod := "Not ";
IF GET_INFO (buf, "MODIFIED") THEN
mod := "";
ENDIF;
nr := "";
IF GET_INFO (buf, "NO_WRITE") THEN
nr := " No Write";
ENDIF;
COPY_TEXT (FAO ("Name: !20AS Lines: !5UL !ASModified!AS",
GET_INFO (buf, "NAME"), GET_INFO (buf, "RECORD_COUNT"),
mod, nr));
SPLIT_LINE;
IF GET_INFO (buf, "OUTPUT_FILE") = 0 THEN
COPY_TEXT ("[No output file]");
ELSE
COPY_TEXT (FAO ("Output file: !AS",GET_INFO (buf, "OUTPUT_FILE")));
ENDIF;
SPLIT_LINE;
SPLIT_LINE;
buf := GET_INFO (BUFFERS, "NEXT");
ENDLOOP;
POSITION (BEGINNING_OF (choice_buffer));
POSITION (pos);
vi$show_list (choice_buffer,
" Current buffers and associated information" +
" ",
info_window);
RETURN (0);
ENDPROCEDURE;
!
! Perform the EX mode "&" command.
!
PROCEDURE vi$do_subs_alias (cmd, i, start_line, end_line, whole_range)
IF vi$replace_separ = 0 THEN
vi$message ("No previous substitution!");
RETURN;
ENDIF;
! Rebuild a proper substitute command.
cmd := SUBSTR (cmd, 1, i-2) + "s" +
vi$replace_separ + vi$replace_source +
vi$replace_separ + vi$replace_dest +
vi$replace_separ + SUBSTR (cmd, i, 255);
RETURN (vi$do_substitute (start_line, end_line, whole_range, i, cmd));
ENDPROCEDURE;
!
! Perform the EX mode "!" command.
!
PROCEDURE vi$do_subproc (cmd, i)
LOCAL
ncmd;
cmd := vi$rest_of_line (cmd, i);
IF cmd = "!" THEN
cmd := vi$last_cmd;
ELSE
vi$last_cmd := cmd;
ENDIF;
IF cmd = 0 THEN
vi$message ("No command on command line!");
RETURN (1);
ENDIF;
IF cmd = "" THEN
vi$message ("Use "":sh"" to get an interactive CLI");
RETURN (1);
ENDIF;
IF (vi$process_special (cmd, ncmd)) THEN
MESSAGE (":!"+ncmd);
UPDATE (message_window);
ENDIF;
vi$spawn (ncmd);
RETURN (0);
ENDPROCEDURE;
!
! This procedure looks at the characters in cmd, and translates occurances
! of the characters % and # to the names of the current buffers file, and
! the previously edited buffers file, respectively.
!
PROCEDURE vi$process_special (cmd, ncmd)
LOCAL
idx,
redo,
ch;
ncmd := "";
idx := 1;
redo := 0;
LOOP
EXITIF idx > LENGTH (cmd);
ch := SUBSTR (cmd, idx, 1);
IF (ch = "%") THEN
ch := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
redo := 1;
ELSE
IF(ch = "#") THEN
IF vi$last_mapped <> 0 THEN
ch := GET_INFO (vi$last_mapped, "OUTPUT_FILE");
redo := 1;
ENDIF;
ENDIF;
ENDIF;
ncmd := ncmd + ch;
idx := idx + 1;
ENDLOOP;
RETURN (redo);
ENDPROCEDURE;
!
! Perform the EX mode copy command.
!
PROCEDURE vi$do_copy (cmd, i, whole_range, olen, start_line, end_line)
LOCAL
spos,
dest;
vi$skip_white (cmd, i);
dest := vi$get_line_spec (i, cmd);
IF (dest > GET_INFO (CURRENT_BUFFER, "RECORD_COUNT")) THEN
dest := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
ENDIF;
IF ((dest < start_line) OR (dest > end_line)) AND (dest > 0) THEN
vi$move_to_line (dest + 1);
spos := vi$get_undo_start;
COPY_TEXT (whole_range);
vi$kill_undo;
MOVE_HORIZONTAL (-1);
vi$undo_end := MARK (NONE);
vi$undo_start := vi$set_undo_start (spos);
ELSE
MESSAGE ("Error in Destination of copy!");
RETURN (1);
ENDIF;
vi$check_length (olen);
RETURN (1);
ENDPROCEDURE;
!
! Perform the EX mode move command.
!
PROCEDURE vi$do_move (cmd, i, whole_range, start_line, end_line)
LOCAL
dest;
vi$skip_white (cmd, i);
dest := vi$get_line_spec (i, cmd);
IF (dest > GET_INFO (CURRENT_BUFFER, "RECORD_COUNT")) THEN
dest := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
ENDIF;
IF ((dest < start_line) OR (dest > end_line)) AND (dest > 0) THEN
vi$move_to_line (dest+1);
vi$undo_end := 0;
vi$kill_undo;
MOVE_TEXT (whole_range);
ELSE
MESSAGE ("Destination of move within source range!");
RETURN (1);
ENDIF;
RETURN (0);
ENDPROCEDURE;
!
! Perform the EX mode select command.
!
PROCEDURE vi$do_select
IF vi$select_pos = 0 THEN
vi$select_pos := SELECT (REVERSE);
vi$message ("Selection started!");
ELSE
vi$select_pos := 0;
vi$message ("Selection canceled!");
ENDIF;
RETURN (1);
ENDPROCEDURE;
!
! Perform the EX mode fill command.
!
PROCEDURE vi$do_fill (cmd, i, whole_range, olen)
LOCAL
separ,
token_1,
token_2;
token_1 := vi$skip_separ (cmd, i, " ", separ);
token_2 := vi$skip_separ (cmd, i, " ", separ);
IF token_1 = "" THEN
token_1 := 0;
ELSE
token_1 := INT (token_1);
ENDIF;
IF token_2 = "" THEN
token_2 := 0;
ELSE
token_2 := INT (token_2);
ENDIF;
IF (vi$select_pos <> 0) THEN
cmd := SELECT_RANGE;
IF (cmd = 0) THEN
vi$message ("Nothing selected!");
RETURN (1);
ENDIF;
vi$select_pos := 0;
vi$fill_region (token_1, token_2, cmd);
ELSE
vi$fill_region (token_1, token_2, whole_range);
ENDIF;
vi$check_length (olen);
RETURN (0);
ENDPROCEDURE;
!
! Perform the EX mode upper, lower, and insert commands.
!
PROCEDURE vi$do_case (token_1, whole_range)
LOCAL
rng,
mode,
pos,
cmd;
IF (vi$select_pos <> 0) THEN
rng := SELECT_RANGE;
vi$select_pos := 0;
mode := VI$IN_LINE_MODE;
vi$update (CURRENT_WINDOW);
ELSE
rng := whole_range;
mode := VI$LINE_MODE;
ENDIF;
cmd := UPPER;
IF SUBSTR (token_1, 1, 1) = "l" THEN
cmd := LOWER;
ELSE
IF (SUBSTR (token_1, 1, 1) = "i") THEN
cmd := INVERT;
ENDIF;
ENDIF;
vi$undo_start := BEGINNING_OF (rng);
vi$undo_end := END_OF (rng);
pos := MARK (NONE);
POSITION (BEGINNING_OF (rng));
vi$save_for_undo (rng, mode, 1);
POSITION (pos);
CHANGE_CASE (rng, cmd);
rng := 0;
RETURN (0);
ENDPROCEDURE;
!
! Perform the EX mode delete command.
!
PROCEDURE vi$do_delete (start_mark, whole_range, olen)
POSITION (start_mark);
IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
MOVE_HORIZONTAL (-1);
vi$undo_start := MARK (NONE);
ELSE
vi$undo_start := 0;
ENDIF;
vi$save_for_undo (whole_range, VI$LINE_MODE, 1);
vi$undo_end := 0;
ERASE (whole_range);
IF (vi$undo_start <> 0) THEN
POSITION (vi$undo_start);
MOVE_HORIZONTAL (1);
vi$undo_start := MARK (NONE);
ELSE
vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
ENDIF;
vi$check_length (olen);
RETURN (0);
ENDPROCEDURE;
!
! Perform the EX mode write command.
!
PROCEDURE vi$do_write (cmd, i, no_spec, token_1, whole_range)
LOCAL
range_used,
outf,
res_spec,
ncmd,
buf,
win,
owin,
bang,
proc,
token_2;
ON_ERROR
IF ERROR = TPU$_PARSEFAIL THEN
MESSAGE ("Don't understand filename, '"+token_2+"'");
RETURN (1);
ENDIF;
ENDON_ERROR;
MESSAGE ("");
bang := vi$parse_next_ch (i, cmd, "!");
vi$skip_white (cmd, i);
IF (vi$parse_next_ch (i, cmd, "!")) THEN
buf := vi$init_buffer ("$$filt_temp$$", "");
win := CREATE_WINDOW (1, vi$scr_length-1, ON);
owin := CURRENT_WINDOW;
IF (buf = 0) OR (win = 0) THEN
MESSAGE ("Can't get buffer and window for command!");
RETURN (1);
ENDIF;
SET (STATUS_LINE, win, REVERSE,
"*Output from command: "+vi$rest_of_line (cmd,i));
MAP (win, buf);
UPDATE (win);
vi$pasthru_off;
proc := CREATE_PROCESS (buf, vi$rest_of_line (cmd, i));
IF proc <> 0 THEN
SEND (whole_range, proc);
IF proc <> 0 THEN
SEND_EOF (proc);
ENDIF;
ENDIF;
UPDATE (win);
MESSAGE ("[Hit RETURN to continue]");
LOOP
EXITIF vi$read_a_key = RET_KEY;
ENDLOOP;
vi$pasthru_on;
UNMAP (win);
DELETE (win);
DELETE (buf);
POSITION (owin);
RETURN (1);
ENDIF;
range_used := 0;
IF (no_spec) AND (vi$select_pos <> 0) THEN
whole_range := SELECT_RANGE;
no_spec := 0;
range_used := 1;
ENDIF;
vi$skip_white (cmd, i);
ncmd := vi$rest_of_line (cmd, i);
vi$process_special (ncmd, token_2);
IF (token_2 <> "") THEN
res_spec := FILE_PARSE (token_2);
outf := FILE_SEARCH ("");
outf := FILE_SEARCH (res_spec);
IF (outf <> "") AND
(outf <> GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE")) AND
NOT bang THEN
vi$message (token_2 +
' exists - use "' +
token_1 +
'! ' +
token_2 +
'" to overwrite.');
RETURN (1);
ELSE
vi$message ("Writing out """+res_spec+"""");
IF (no_spec = 0) THEN
WRITE_FILE (whole_range, res_spec);
ELSE
WRITE_FILE (CURRENT_BUFFER, res_spec);
ENDIF;
ENDIF;
ELSE
IF (no_spec = 0) THEN
IF bang THEN
vi$message ('Use "w!" to write partial buffer');
outf := "";
ELSE
outf := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
IF outf <> "" THEN
vi$message ("Writing out """+outf+"""");
outf := WRITE_FILE (whole_range, outf);
ELSE
vi$message ("Buffer has no output file!");
ENDIF;
ENDIF;
ELSE
vi$message ("Writing out """+
GET_INFO (CURRENT_BUFFER, "NAME")+"""");
outf := WRITE_FILE (CURRENT_BUFFER);
ENDIF;
IF (outf <> "") THEN
SET (OUTPUT_FILE, CURRENT_BUFFER, outf);
ENDIF;
ENDIF;
IF range_used THEN
vi$select_pos := 0;
ENDIF;
vi$kill_undo;
vi$undo_end := 0;
! Always leave message visible
RETURN (1);
ENDPROCEDURE;
!
! Perform the EX mode read command.
!
PROCEDURE vi$do_read (cmd, i, start_line, olen)
LOCAL
outf,
spos,
epos,
ret,
token_2,
token_3;
MESSAGE ("");
token_3 := vi$rest_of_line (cmd, i);
vi$process_special (token_3, token_2);
i := 1;
vi$skip_white (token_3, i);
IF (vi$parse_next_ch (i, token_3, "!")) THEN
MOVE_HORIZONTAL (-CURRENT_OFFSET);
vi$move_vertical (1);
SPLIT_LINE;
MOVE_HORIZONTAL (-1);
vi$kill_undo;
epos := MARK (NONE);
spos := MARK (NONE);
vi$undo_start := vi$get_undo_start;
ret := vi$filter_region (CREATE_RANGE (spos, epos, NONE),
vi$rest_of_line (token_3, i));
MOVE_HORIZONTAL (-1);
vi$undo_end := MARK (NONE);
vi$undo_start := vi$set_undo_start (vi$undo_start);
POSITION (vi$undo_start);
RETURN (ret);
ENDIF;
token_3 := vi$rest_of_line (cmd, i);
vi$process_special (token_3, token_2);
IF (token_2 <> "") THEN
token_2 := FILE_PARSE (token_2);
outf := FILE_SEARCH ("");
outf := FILE_SEARCH (token_2);
IF (outf <> "") THEN
IF (start_line > 0) THEN
POSITION (BEGINNING_OF (CURRENT_BUFFER));
MOVE_VERTICAL (start_line - 1);
ENDIF;
MOVE_HORIZONTAL (-CURRENT_OFFSET);
IF (MARK (NONE) = END_OF (CURRENT_BUFFER)) THEN
SPLIT_LINE;
ELSE
MOVE_VERTICAL (1);
ENDIF;
MOVE_HORIZONTAL (-1);
spos := MARK (NONE);
MOVE_HORIZONTAL (1);
outf := READ_FILE (outf);
IF (outf <> "") THEN
MOVE_HORIZONTAL (-1);
vi$undo_end := MARK (NONE);
vi$kill_undo;
POSITION (spos);
MOVE_HORIZONTAL (1);
vi$undo_start := MARK (NONE);
ENDIF;
ELSE
vi$message (token_2 + " does not exist!");
ENDIF;
ELSE
vi$message ("Filename required!");
ENDIF;
vi$check_length (olen);
! Always leave last message visible
RETURN (1);
ENDPROCEDURE;
!
! Perform the EX mode file command.
!
PROCEDURE vi$do_file_ex (cmd, i)
LOCAL
token_2;
ON_ERROR
IF ERROR = TPU$_PARSEFAIL THEN
vi$message ("Don't understand filename: "+token_2);
ENDIF;
ENDON_ERROR;
MESSAGE ("");
token_2 := vi$rest_of_line (cmd, i);
IF (token_2 <> "") THEN
token_2 := FILE_PARSE (token_2);
SET (OUTPUT_FILE, CURRENT_BUFFER, token_2);
vi$status_lines (CURRENT_BUFFER);
ENDIF;
vi$what_line;
RETURN (1);
ENDPROCEDURE;
!
! Perform the EX mode buffer command.
!
PROCEDURE vi$do_buffer (cmd, i, token_1)
LOCAL
buf,
bang,
separ,
token_2,
token_3;
ON_ERROR
IF ERROR = TPU$_PARSEFAIL THEN
MESSAGE ("Don't understand filename given!");
RETURN (1);
ENDIF;
ENDON_ERROR;
MESSAGE ("");
bang := vi$parse_next_ch (i, cmd, "!");
token_2 := vi$skip_separ (cmd, i, " ", separ);
token_3 := vi$skip_separ (cmd, i, " ", separ);
IF (vi$rest_of_line (cmd, i) <> "") THEN
vi$message ("Too many paramters!");
RETURN (1);
ENDIF;
IF (token_2 <> "") THEN
IF (token_3 = "") THEN
buf := vi$find_buffer_by_name (token_2);
IF buf = 0 THEN
buf := vi$_create_buffer (token_2, 0, 0);
ENDIF;
ELSE
token_3 := FILE_PARSE (token_3);
buf := vi$_create_buffer (token_2, token_3, token_3);
ENDIF;
IF (buf <> 0) THEN
vi$check_auto_write;
MAP (CURRENT_WINDOW, buf);
vi$set_status_line (CURRENT_WINDOW);
ENDIF;
ELSE
vi$what_line;
ENDIF;
vi$kill_undo;
vi$undo_end := 0;
RETURN (1);
ENDPROCEDURE;
!
! Perform the EX mode "vi" and/or "edit" commands.
!
PROCEDURE vi$do_edit (cmd, i, token_1)
LOCAL
buf,
bang,
num,
look,
ch,
endch,
token_2;
num := -1;
look := -1;
MESSAGE ("");
bang := vi$parse_next_ch (i, cmd, "!");
vi$skip_white (cmd, i);
IF vi$parse_next_ch (i, cmd, "+") THEN
! Get a goto spec.
IF vi$parse_next_ch (i, cmd, "/") THEN
! Get a search string
look := "";
IF vi$parse_next_ch (i, cmd, '"') THEN
endch := '"';
ELSE
endch := " ";
ENDIF;
LOOP
ch := vi$next_char (cmd, i);
EXITIF (endch = ch) OR (ch = "");
IF (ch = "/") THEN
ch := vi$next_char (cmd, i);
IF ch <> '"' THEN
ch := "/" + ch;
ENDIF;
ENDIF;
look := look + ch;
ENDLOOP;
vi$skip_white (cmd, i);
ELSE
! Get a number
num := "";
LOOP
EXITIF INDEX (vi$_numeric_chars, SUBSTR (cmd, i, 1)) = 0;
num := num + vi$next_char (cmd, i);
ENDLOOP;
vi$skip_white (cmd, i);
num := INT (num);
ENDIF;
ENDIF;
token_2 := vi$rest_of_line (cmd, i);
! Check for use of % as file name, this means current file, so it is
! synonomous with specifying no filename.
IF (token_2 = "") OR (token_2 = "%") THEN
IF (NOT bang) AND (GET_INFO (CURRENT_BUFFER, "MODIFIED")) THEN
vi$message ("No write since last change, use """ +
token_1 + "!"" to override");
RETURN (1);
ENDIF;
token_2 := GET_INFO (CURRENT_BUFFER, "FILE_NAME");
IF (token_2 = 0) OR (token_2 = "") THEN
vi$message ("Buffer has no file!");
RETURN (1);
ENDIF;
! Get everything but the version.
token_2 := FILE_PARSE (token_2, "", "", DEVICE) +
FILE_PARSE (token_2, "", "", DIRECTORY) +
FILE_PARSE (token_2, "", "", NAME) +
FILE_PARSE (token_2, "", "", TYPE);
buf := CURRENT_BUFFER;
MAP (CURRENT_WINDOW, MESSAGE_BUFFER);
POSITION (MESSAGE_BUFFER);
DELETE (buf);
ENDIF;
! Check for abbreviation for previous file, and just swap buffers if
! that is the case.
IF (token_2 = "#") THEN
vi$move_prev_buf;
ELSE
vi$get_file (token_2);
vi$pos_in_middle (MARK (NONE));
vi$kill_undo;
vi$undo_end := 0;
ENDIF;
IF (num <> -1) THEN
vi$move_to_line (num);
vi$pos_in_middle (MARK (NONE));
ELSE
IF (look <> -1) THEN
vi$search_string := look;
num := vi$find_str (look, 0);
IF (num <> 0) THEN
vi$position (num, 1);
vi$pos_in_middle (MARK (NONE));
ENDIF;
ENDIF;
ENDIF;
RETURN (1);
ENDPROCEDURE;
!
! Perform the EX mode messages command.
!
PROCEDURE vi$do_messages
MAP (CURRENT_WINDOW, MESSAGE_BUFFER);
POSITION (MESSAGE_BUFFER);
vi$set_status_line (CURRENT_WINDOW);
vi$kill_undo;
vi$undo_end := 0;
RETURN (0);
ENDPROCEDURE;
!
! Perform the EX mode tag command.
!
PROCEDURE vi$do_tag (tag_str);
vi$load_tags;
RETURN (vi$to_tag (tag_str));
ENDPROCEDURE;
!
! Load the tags files into a buffer
!
PROCEDURE vi$load_tags
LOCAL
idx,
fname,
ch,
flist,
pos;
ON_ERROR
ENDON_ERROR;
pos := MARK (NONE);
ERASE (vi$tag_buf);
POSITION (BEGINNING_OF (vi$tag_buf));
idx := 0;
fname := "";
flist := vi$tag_files + " ";
LOOP
EXITIF (idx > LENGTH(flist));
ch := SUBSTR (flist, idx, 1);
IF (INDEX (" ", ch) <> 0) AND (fname <> "") THEN
vi$info_success_off;
fname := FILE_PARSE (fname);
IF (fname <> "") AND (FILE_SEARCH (fname) <> "") THEN
READ_FILE (FILE_PARSE (fname));
ENDIF;
vi$info_success_on;
fname := "";
ELSE
IF (INDEX (" ", ch) = 0) THEN
fname := fname + ch;
ENDIF;
ENDIF;
idx := idx + 1;
ENDLOOP;
POSITION (pos);
RETURN (0);
ENDPROCEDURE;
!
! Position to the tag given or use the current symbol in the buffer
!
PROCEDURE vi$to_tag (tag)
LOCAL
fname,
sch_pat,
tloc,
pos;
ON_ERROR
ENDON_ERROR;
pos := MARK (NONE);
IF (tag = 0) THEN
tag := vi$sym_name;
ENDIF;
IF (tag = "") THEN
MESSAGE ("Bad tag name");
POSITION (pos);
RETURN (1);
ENDIF;
POSITION (BEGINNING_OF (vi$tag_buf));
IF (MARK (NONE) = END_OF (vi$tag_buf)) THEN
MESSAGE ("NO tags file!");
POSITION (pos);
RETURN (1);
ENDIF;
vi$global_var := 0;
EXECUTE (COMPILE ("vi$global_var := LINE_BEGIN & '"+tag+" '"));
vi$info_success_off;
tloc := SEARCH (vi$global_var, FORWARD, vi$tag_case);
vi$info_success_on;
IF (tloc <> 0) THEN
POSITION (END_OF (tloc));
MOVE_HORIZONTAL (1);
fname := vi$space_word;
sch_pat := SUBSTR (CURRENT_LINE, CURRENT_OFFSET+2, 1024);
POSITION (pos);
IF (vi$get_file (fname) > 0) THEN
POSITION (END_OF (CURRENT_BUFFER));
IF (vi$do_cmd_line (sch_pat)) THEN
POSITION (BEGINNING_OF (CURRENT_BUFFER));
MESSAGE ("Tag not found!");
RETURN (1);
ENDIF;
vi$pos_in_middle (MARK (NONE));
ENDIF;
ELSE
POSITION (pos);
MESSAGE ("Tag not in tags file");
RETURN (1);
ENDIF;
RETURN (0);
ENDPROCEDURE;
!
! Return the word that is spanned by characters in the symbol set.
!
PROCEDURE vi$sym_name
LOCAL
ch;
ch := "";
LOOP
EXITIF INDEX (vi$_sym_chars, CURRENT_CHARACTER) = 0;
ch := ch + CURRENT_CHARACTER;
MOVE_HORIZONTAL (1);
ENDLOOP;
RETURN (ch);
ENDPROCEDURE;
!
! Return the word that is spanned by non-blank characters.
!
PROCEDURE vi$space_word
LOCAL
ch;
ch := "";
LOOP
EXITIF (CURRENT_CHARACTER = " ") OR (CURRENT_CHARACTER = " ");
ch := ch + CURRENT_CHARACTER;
MOVE_HORIZONTAL (1);
ENDLOOP;
RETURN (ch);
ENDPROCEDURE;
!
! Perform the EX mode tpu command.
!
PROCEDURE vi$do_tpu (cmd, i, no_spec, whole_range)
ON_ERROR
RETURN (1);
ENDON_ERROR;
IF no_spec AND (vi$rest_of_line (cmd, i) <> "") THEN
EXECUTE (COMPILE (vi$rest_of_line (cmd, i)));
ELSE
vi$message ("Compiling...");
IF no_spec AND (vi$rest_of_line (cmd, i) = "") THEN
IF (vi$select_pos <> 0) THEN
EXECUTE (COMPILE (SELECT_RANGE));
vi$select_pos := 0;
ELSE
vi$message ("Nothing selected to compile!");
RETURN (1);
ENDIF;
ELSE
COMPILE (whole_range);
ENDIF;
ENDIF;
RETURN (1);
ENDPROCEDURE;
!
!
!
PROCEDURE vi$do_wq (cmd, i, no_spec, token_1, whole_range)
vi$do_write (cmd, i, no_spec, token_1, whole_range);
vi$do_quit (cmd, token_1);
RETURN (1);
ENDPROCEDURE;
!
! Perform the EX mode quit command.
!
PROCEDURE vi$do_quit (cmd, token_1)
LOCAL
buf;
buf := GET_INFO (BUFFERS, "FIRST");
LOOP
EXITIF buf = 0;
IF GET_INFO (buf, "MODIFIED") AND
(NOT GET_INFO (buf, "SYSTEM")) THEN
IF NOT GET_INFO (buf, "NO_WRITE") THEN
IF INDEX (cmd, "!") <> 0 THEN
SET (NO_WRITE, buf);
ELSE
vi$message ("No write of buffer """+GET_INFO (buf, "NAME")
+
""" since last change, use """+token_1 +
"!"" to override.");
RETURN (1);
ENDIF;
ENDIF;
ENDIF;
buf := GET_INFO (BUFFERS, "NEXT");
ENDLOOP;
vi$quit;
RETURN (1);
ENDPROCEDURE;
!
! Delete the buffer given by the name passed as the parameter. The buffer
! must not be the current buffer, or if it is, there must be more than
! one buffer on the screen.
!
PROCEDURE vi$do_delbuf (cmd, i)
LOCAL
win,
confirm,
possible_buffer,
possible_buffer_name,
found_a_buffer,
how_many_buffers,
this_buffer,
loop_buffer,
bang,
buffer_name;
! Get the buffer name, solving abiguity problems.
bang := vi$parse_next_ch (i, cmd, "!");
vi$skip_white (cmd, i);
buffer_name := vi$rest_of_line (cmd, i);
CHANGE_CASE (buffer_name, UPPER); ! for messages
loop_buffer := vi$find_buffer_by_name (buffer_name);
IF (loop_buffer <> 0) THEN
buffer_name := GET_INFO (loop_buffer, "NAME");
! Now, we must first delete all windows mapped to this buffer.
win := GET_INFO (WINDOWS, "FIRST");
LOOP
EXITIF (win = 0);
EXITIF (GET_INFO (loop_buffer, "MAP_COUNT") = 0);
! See if current window is mapped to this buffer.
IF (GET_INFO (win, "BUFFER") = loop_buffer) THEN
! If so, there must be a previous or a next window to move to.
! If there is not, then we can not delete the buffer until
! another buffer (and window) are available to move to.
IF (vi$prev_win (win) <> 0) OR (vi$next_win(win) <> 0) THEN
POSITION (win);
vi$del_win (win);
! Restart at beginning of list. Deleting a window will
! make "NEXT" not work.
win := GET_INFO (WINDOWS, "FIRST");
ELSE
MESSAGE ("Can't unmap all windows that are mapped to """ +
buffer_name + """!");
RETURN (1);
ENDIF;
ELSE
win := GET_INFO (WINDOWS, "NEXT");
ENDIF;
ENDLOOP;
ELSE
MESSAGE ("No such buffer, "+buffer_name);
RETURN (1);
ENDIF;
CHANGE_CASE (buffer_name, UPPER);
IF (GET_INFO (loop_buffer, "MAP_COUNT") = 0) THEN
IF (GET_INFO (loop_buffer, "MODIFIED") AND NOT bang) THEN
confirm := READ_LINE ("Delete modified buffer, """+
buffer_name+"""? ");
EDIT (confirm, UPPER);
IF (SUBSTR (confirm, 1, 1) <> "Y") THEN
MESSAGE ("Buffer NOT deleted!");
RETURN (1);
ENDIF;
ENDIF;
DELETE (loop_buffer);
MESSAGE ("Buffer, """+buffer_name+""", deleted!");
ELSE
MESSAGE ("Can't delete """+buffer_name+
""", it is still mapped to a window!");
RETURN (1);
ENDIF;
! Normally we would return 0, but the above message must remain visible.
RETURN (1);
ENDPROCEDURE;
!
! Return the proper value of a MARKER that indicates the previous position
! in the current buffer.
!
PROCEDURE vi$get_undo_start
LOCAL
pos;
IF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) THEN
RETURN (0);
ELSE
MOVE_HORIZONTAL (-1);
pos := MARK (NONE);
MOVE_HORIZONTAL (1);
RETURN (pos);
ENDIF;
ENDPROCEDURE;
!
! Use "spos" to determine where "vi$undo_start" should be set.
!
PROCEDURE vi$set_undo_start (spos)
IF spos = 0 THEN
RETURN (BEGINNING_OF (CURRENT_BUFFER));
ELSE
POSITION (spos);
MOVE_HORIZONTAL (1);
RETURN (MARK (NONE));
ENDIF;
ENDPROCEDURE;
!
! If this was real VI under UNIX, all you would need to do is filter text
! through NROFF... sigh... I guess you can't have it all?
!
PROCEDURE vi$fill_region (leftm, rightm, rng)
LOCAL
pos,
end,
spos,
beg;
IF (leftm = 0) THEN
leftm := 1;
ENDIF;
IF (rightm = 0) THEN
rightm := vi$scr_width;
ENDIF;
POSITION (BEGINNING_OF (rng));
LOOP
EXITIF (CURRENT_CHARACTER <> " ") AND (CURRENT_CHARACTER <> " ");
MOVE_HORIZONTAL (1);
EXITIF (MARK (NONE) = END_OF (rng));
ENDLOOP;
beg := MARK (NONE);
POSITION (END_OF (rng));
MOVE_HORIZONTAL (-1);
end := MARK (NONE);
rng := CREATE_RANGE (beg, end, NONE);
POSITION (BEGINNING_OF (rng));
vi$save_for_undo (rng, VI$IN_LINE_MODE, 1);
spos := vi$get_undo_start;
FILL (rng, " ", leftm, rightm);
vi$undo_end := MARK (NONE);
vi$undo_start := vi$set_undo_start (spos);
POSITION (vi$undo_start);
ENDPROCEDURE;
!
! Given a buffer name, return the buffer TYPE variable for that buffer.
!
PROCEDURE vi$find_buffer_by_name (bname_param)
LOCAL
cnt,
bname,
possible,
pbuf,
buf;
bname := bname_param;
CHANGE_CASE (bname, UPPER);
buf := GET_INFO (BUFFERS, "FIRST");
cnt := 0;
LOOP
EXITIF buf = 0;
possible := GET_INFO (buf, "NAME");
EXITIF bname = possible;
IF vi$leading_str (bname, possible) THEN
cnt := cnt + 1;
pbuf := buf;
ENDIF;
buf := GET_INFO (BUFFERS, "NEXT");
ENDLOOP;
IF buf = 0 THEN
IF cnt = 1 THEN
buf := pbuf;
ENDIF;
ENDIF;
RETURN (buf);
ENDPROCEDURE;
!
! Effect a key mapping, and squirl away the original mapping so that
! it can be restore later.
!
PROCEDURE vi$map_keys (cmd, i)
LOCAL
comment_string,
separ,
pos,
buf,
map_type,
keyn,
key;
map_type := vi$cmd_keys;
IF (vi$parse_next_ch (i, cmd, "!")) THEN
map_type := vi$edit_keys;
ENDIF;
IF SUBSTR (cmd, i, 1) <> " " THEN
vi$show_maps;
RETURN(1);
ENDIF;
vi$skip_white (cmd, i);
IF (i > LENGTH (cmd)) THEN
vi$show_maps;
RETURN (1);
ENDIF;
key := KEY_NAME (SUBSTR (cmd, i, 1));
i := i + 1;
comment_string := LOOKUP_KEY (key, COMMENT, map_type);
vi$skip_white (cmd, i);
IF (key < 32) THEN
key := ((CTRL_B_KEY - CTRL_A_KEY) * (key - 1)) + CTRL_A_KEY;
ENDIF;
keyn := vi$key_map_name (key);
IF (map_type = vi$edit_keys) AND (comment_string <> 0) AND
(comment_string <> "") AND (comment_string <> "active_macro") THEN
vi$message ("You can't redefine that key!");
RETURN (1);
ENDIF;
vi$global_var := 0;
IF comment_string <> "active_macro" THEN
EXECUTE (COMPILE (
"vi$global_var := vi$init_buffer ('vi$$key_map_" +
keyn + map_type + "', '');"));
buf := vi$global_var;
EXECUTE (COMPILE ("vi$$key_map_buf_" +
keyn + map_type + " := vi$global_var;"));
pos := MARK (NONE);
POSITION (buf);
SPLIT_LINE;
COPY_TEXT (comment_string);
ELSE
EXECUTE (COMPILE ("vi$global_var := vi$$key_map_buf_" +
keyn + map_type + ";"));
buf := vi$global_var;
pos := MARK (NONE);
POSITION (BEGINNING_OF (buf));
LOOP
EXITIF (CURRENT_LINE = "");
ERASE_LINE;
ENDLOOP;
ENDIF;
POSITION (BEGINNING_OF (buf));
LOOP
EXITIF (i > LENGTH (cmd));
COPY_TEXT (STR (KEY_NAME (SUBSTR (cmd, i, 1))));
SPLIT_LINE;
i := i + 1;
ENDLOOP;
POSITION (BEGINNING_OF (buf));
POSITION (pos);
vi$info_success_off;
IF (map_type = vi$edit_keys) THEN
EXECUTE (COMPILE
("DEFINE_KEY ('vi$insert_macro_keys (vi$$key_map_buf_" + keyn +
map_type + ")', " + STR(key) + ", 'active_macro', vi$edit_keys);"))
;
ELSE
EXECUTE (COMPILE ("DEFINE_KEY ('vi$do_macro (vi$$key_map_buf_" + keyn +
map_type + ", 1)', " + STR(key) +
", 'active_macro', vi$cmd_keys);"));
ENDIF;
vi$info_success_on;
RETURN (0);
ENDPROCEDURE;
!
! Unmap a key mapping and restore the original if one existed.
!
PROCEDURE vi$unmap_keys (cmd, i)
LOCAL
comment_string,
separ,
pos,
buf,
map_type,
keyn,
key;
map_type := vi$cmd_keys;
IF (SUBSTR (cmd, i, 1) = "!") THEN
map_type := vi$edit_keys;
i := i + 1;
ELSE
IF SUBSTR (cmd, i, 1) <> " " THEN
vi$message ("Bad command!");
RETURN;
ENDIF;
ENDIF;
vi$skip_white (cmd, i);
key := KEY_NAME (SUBSTR (cmd, i ,1));
comment_string := LOOKUP_KEY (key, COMMENT, map_type);
IF comment_string <> "active_macro" THEN
vi$message ("Key not currently mapped!");
RETURN;
ENDIF;
keyn := vi$key_map_name (key);
vi$global_var := 0;
EXECUTE (COMPILE ("vi$global_var := vi$$key_map_buf_" +
keyn + map_type + ";"));
buf := vi$global_var;
pos := MARK (NONE);
POSITION (END_OF (buf));
MOVE_VERTICAL (-1);
vi$info_success_off;
EXECUTE (COMPILE ("DEFINE_KEY ('"+CURRENT_LINE +
"', "+STR(key)+", '"+CURRENT_LINE+"', '" + map_type + "')"));
vi$info_succ(strum beelar)