v04i102: TPUVI for VMS part 11 of 17
Gregg Wonderly
gregg at a.cs.okstate.edu
Tue Sep 27 11:56:36 AEST 1988
Posting-number: Volume 4, Issue 102
Submitted-by: "Gregg Wonderly" <gregg at a.cs.okstate.edu>
Archive-name: vms-vi-2/Part11
$ WRITE SYS$OUTPUT "Creating ""VI.7"""
$ CREATE VI.7
$ DECK/DOLLARS=$$EOD$$
vi$info ("Press key to bind sequence to: ");
keyn := vi$read_a_key;
IF (keyn = F11) OR (ASCII (27) = ASCII (keyn)) THEN
vi$info ("LEARN aborted!");
com := LEARN_END;
vi$in_learn := 0;
RETURN (1);
ENDIF;
com := LOOKUP_KEY (keyn, COMMENT, vi$cmd_keys);
IF (com = "active_macro") THEN
vi$info ("That key is a mapped key, you must unmap it first");
RETURN (1);
ENDIF;
key := "vi$ls_"+vi$key_map_name (keyn);
EXECUTE (COMPILE (key+":=LEARN_END"));
vi$in_learn := 0;
DEFINE_KEY ("vi$play_back("+key+")", keyn, "learn_sequence", vi$cmd_keys);
vi$info ("Sequence bound to key");
RETURN (1);
ENDPROCEDURE;
!
!
!
PROCEDURE vi$play_back (prog)
LOCAL
old_play_back,
old_global;
IF (vi$m_level > 30) THEN
vi$info ("Infinite loop detected in key macro sequence!");
RETURN;
ENDIF;
vi$m_level := vi$m_level + 1;
IF vi$undo_map THEN
old_global := vi$in_global;
vi$in_global := 0;
IF (NOT old_global) THEN
vi$save_for_undo (CURRENT_BUFFER, VI$LINE_MODE, 1);
vi$in_global := 1;
ENDIF;
ENDIF;
old_play_back := vi$playing_back;
vi$playing_back := 1;
EXECUTE (prog);
vi$playing_back := old_play_back;
vi$m_level := vi$m_level - 1;
vi$in_global := old_global;
ENDPROCEDURE;
!
! Remove an abbreviation
!
PROCEDURE vi$do_unabbr (cmd, i)
LOCAL
separ,
junk,
idx,
ch,
abbr,
abbrn;
abbr := "";
abbrn := "";
junk := vi$skip_separ (cmd, i, vi$_space_tab, separ);
IF (LENGTH (junk) = 0) THEN
vi$info ("Abbreviation name required!");
RETURN (1);
ENDIF;
idx := 1;
LOOP
EXITIF idx > LENGTH (junk);
ch := SUBSTR (junk, idx, 1);
IF (INDEX (vi$_alpha_chars, ch) = 0) THEN
vi$info ("Invalid character in UNABBR name, '"+ch+
"', is not valid.");
RETURN (1);
ENDIF;
IF (INDEX (vi$_upper_chars, ch) <> 0) THEN
abbrn := abbrn + "_";
ENDIF;
abbrn := abbrn + ch;
idx := idx + 1;
ENDLOOP;
EXECUTE (COMPILE ("VI$ABBR_"+abbrn+":=0;"));
RETURN (0);
ENDPROCEDURE;
!
! Create an abbreviation
!
PROCEDURE vi$do_abbr (cmd, i)
LOCAL
separ,
abbr,
nabbr,
junk,
idx,
ch,
abbrn;
abbr := "";
abbrn := "";
! Check for query.
junk := vi$skip_separ (cmd, i, vi$_space_tab, separ);
IF (LENGTH (junk) = 0) THEN
vi$show_abbrevs;
RETURN (0);
ENDIF;
! Check that the abbrievation name can be part of a variable name
idx := 1;
LOOP
EXITIF idx > LENGTH (junk);
ch := SUBSTR (junk, idx, 1);
IF (INDEX (vi$_alpha_chars, ch) = 0) THEN
vi$info ("Invalid character in ABBR name, '"+ch+"', is not valid.");
RETURN (1);
ENDIF;
IF (INDEX (vi$_upper_chars+"_", ch) <> 0) THEN
abbrn := abbrn + "_";
ENDIF;
abbrn := abbrn + ch;
idx := idx + 1;
ENDLOOP;
abbr := vi$rest_of_line (cmd, i);
nabbr := vi$dbl_chars ('"', abbr);
EXECUTE (COMPILE ("VI$ABBR_"+abbrn+":="""+nabbr+""""));
RETURN (0);
ENDPROCEDURE;
PROCEDURE vi$dbl_chars (dch, line)
LOCAL
ch,
idx,
nstr;
! Double all '"' quotes.
idx := 1;
nstr := "";
LOOP
EXITIF idx > LENGTH (line);
ch := SUBSTR (line, idx, 1);
IF (ch = dch) THEN
ch := dch+dch;
ENDIF;
nstr := nstr + ch;
idx := idx + 1;
ENDLOOP;
RETURN (nstr);
ENDPROCEDURE;
!
! Execute the contents of the buffers named following an '@'.
!
PROCEDURE vi$do_macro_buffer (cmd, i)
LOCAL
line,
mode,
buf_name,
pos,
buf,
ch;
ON_ERROR
ENDON_ERROR;
vi$skip_white (cmd, i);
LOOP
ch := vi$next_char (cmd, i);
EXITIF (ch = "");
IF (INDEX ("123456789", ch) <> 0) THEN
! Selected a deletion buffer.
buf_name := "vi$del_buf_" + ch;
ELSE
IF (INDEX (vi$_letter_chars, ch) <> 0) THEN
! Selected a named buffer.
CHANGE_CASE (ch, LOWER);
buf_name := "vi$ins_buf_" + ch;
ELSE
vi$info ("Invalid buffer!");
RETURN;
ENDIF;
ENDIF;
vi$global_var := 0;
EXECUTE (COMPILE ("vi$global_var := "+buf_name+";"));
buf := vi$global_var;
IF (buf = 0) THEN
vi$info ("There is no text in that buffer!");
RETURN;
ENDIF;
pos := MARK (NONE);
POSITION (BEGINNING_OF (buf));
! Skip the buffer mode indicator.
mode := INT (vi$current_line);
MOVE_VERTICAL (1);
line := vi$current_line;
IF mode = VI$LINE_MODE THEN
line := line + ASCII (13);
ENDIF;
POSITION (pos);
vi$do_macro (line, 1);
ENDLOOP;
ENDPROCEDURE;
!
! Do the ex mode 'g' and 'v' commands
!
PROCEDURE vi$do_global (cmd, i, cmd_ch)
LOCAL
pwin,
pbuf,
obuf,
cmd_str,
sch_str,
subs_str,
sch,
separ,
ch,
nsubs,
lpos,
opos,
olen,
fpos;
opos := MARK (NONE);
olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
vi$skip_white (cmd, i);
IF NOT vi$parse_next_ch (i, cmd, "/") THEN
vi$info ("/ Search string must follow global!");
RETURN (1);
ENDIF;
sch := SUBSTR (cmd, i-1, 1);
sch_str := "";
LOOP
EXITIF (vi$parse_next_ch (i, cmd, sch));
EXITIF (LENGTH (cmd) < i);
ch := SUBSTR (cmd, i, 1);
IF (ch = "\") THEN
sch_str := sch_str + SUBSTR (cmd, i, 2);
i := i + 1;
ELSE
sch_str := sch_str + ch;
ENDIF;
i := i + 1;
ENDLOOP;
IF (LENGTH (cmd) < i) THEN
vi$info ("Incomplete command! ("+cmd+")");
RETURN (1);
ENDIF;
vi$save_for_undo (CURRENT_BUFFER, VI$LINE_MODE, 1);
cmd_str := vi$rest_of_line (cmd, i);
SET (FORWARD, CURRENT_BUFFER);
POSITION (BEGINNING_OF (CURRENT_BUFFER));
subs := SUBSTR (cmd_str, 1, 1) = "s";
dell := cmd_str = "d";
prt := cmd_str = "p";
IF subs THEN
nsubs := 0;
subs_str := SUBSTR (cmd_str, 2, 255);
separ := SUBSTR (subs_str, 2, 1);
IF (SUBSTR (cmd_str,1,1)+SUBSTR (subs_str, 1, 2) = "s"+separ+separ) THEN
subs_str := separ+sch_str+separ+SUBSTR (subs_str, 3, 255);
ENDIF;
ENDIF;
IF prt THEN
pwin := CURRENT_WINDOW;
obuf := CURRENT_BUFFER;
pbuf := vi$init_buffer ("$$prt_temp$$", "");
MAP (pwin, pbuf);
UPDATE (pwin);
POSITION (BEGINNING_OF (obuf));
ENDIF;
LOOP
fpos := vi$find_str (sch_str, 1, 0);
EXITIF (fpos = 0) AND (cmd_ch = "g");
EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
IF cmd_ch = "g" THEN
POSITION (fpos);
IF dell THEN
ERASE_LINE;
ELSE
IF subs THEN
lpos := vi$global_subs (subs_str, nsubs);
POSITION (LINE_BEGIN);
MOVE_VERTICAL (1);
ELSE
IF prt THEN
vi$prt_line (fpos, CURRENT_LINE, pbuf, pwin);
MOVE_VERTICAL (1);
ELSE
vi$info ("Bad command for global! ("+cmd_str+")");
vi$kill_undo;
vi$undo_end := 0;
RETURN (1);
ENDIF;
ENDIF;
ENDIF;
ELSE
IF cmd_ch = "v" THEN
IF (fpos = 0) THEN
fpos := END_OF (CURRENT_BUFFER);
ENDIF;
POSITION (fpos);
POSITION (LINE_BEGIN);
fpos := MARK (NONE);
POSITION (opos);
LOOP
EXITIF (fpos = MARK(NONE));
EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER));
IF dell THEN
ERASE_LINE;
ELSE
IF subs THEN
lpos := vi$global_subs (subs_str, nsubs);
POSITION (LINE_BEGIN);
MOVE_VERTICAL (1);
ELSE
IF prt THEN
POSITION (fpos);
vi$prt_line (fpos, CURRENT_LINE, pbuf, pwin);
MOVE_VERTICAL (1);
ELSE
vi$info
("Bad command for global! ("+cmd_str+")");
vi$kill_undo;
vi$undo_end := 0;
RETURN (1);
ENDIF;
ENDIF;
ENDIF;
ENDLOOP;
IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
MOVE_VERTICAL (1);
ENDIF;
opos := MARK (NONE);
ENDIF;
ENDIF;
ENDLOOP;
IF prt THEN
MESSAGE ("[Hit ENTER to continue]");
LOOP
EXITIF (vi$read_a_key = RET_KEY);
ENDLOOP;
MESSAGE (" ");
MAP (pwin, obuf);
DELETE (pbuf);
POSITION (opos);
ENDIF;
IF subs THEN
vi$info (STR (nsubs) + " substitutions.");
ENDIF;
IF (subs OR dell) THEN
POSITION (lpos);
vi$undo_end := END_OF (CURRENT_BUFFER);
vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
vi$check_length (olen);
ENDIF;
RETURN (1);
ENDPROCEDURE;
!
! Do print line for g and v EX-mode commands.
!
PROCEDURE vi$prt_line (opos, pline, pbuf, pwin)
POSITION (pbuf);
COPY_TEXT (pline);
SPLIT_LINE;
UPDATE (pwin);
POSITION (opos);
ENDPROCEDURE;
!
! Print the range of lines indicated, in the current window.
!
PROCEDURE vi$do_print (where, startl, endl)
ON_ERROR
RETURN;
ENDON_ERROR;
POSITION (where);
SET (FORWARD, CURRENT_BUFFER);
POSITION (LINE_BEGIN);
SCROLL (CURRENT_WINDOW, endl-startl);
vi$info ("[Hit ENTER to continue]");
LOOP
EXITIF vi$read_a_key = RET_KEY;
ENDLOOP;
vi$pos_in_middle (MARK (NONE));
RETURN (0);
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);
vi$info ("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
vi$info (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
vi$info ("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$info ("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
tstr,
errno,
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$info ("No command on command line!");
RETURN (1);
ENDIF;
IF cmd = "" THEN
vi$info ("Use "":sh"" to get an interactive CLI");
RETURN (1);
ENDIF;
IF (vi$process_special (cmd, ncmd)) THEN
vi$mess_select (NONE);
vi$info (":!"+ncmd);
UPDATE (message_window);
ENDIF;
vi$pasthru_off;
ncmd := vi$dbl_chars ('"', ncmd);
vi$spawn ('@VI$ROOT:[EXE]DOSPAWN "'+ncmd+'"');
vi$pasthru_on;
vi$mess_select (REVERSE);
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
vi$info ("Error in copy range!");
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
vi$info ("Error in move 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$info ("Selection started!");
ELSE
vi$select_pos := 0;
vi$info ("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, vi$_space_tab, separ);
token_2 := vi$skip_separ (cmd, i, vi$_space_tab, 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$info ("Nothing selected!");
RETURN (1);
ENDIF;
vi$select_pos := 0;
vi$fill_region (token_1, token_2, cmd);
MESSAGE ("");
ELSE
vi$fill_region (token_1, token_2, whole_range);
ENDIF;
vi$info ("Fill complete!");
sleep (1);
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
vi$info ("Don't understand filename, '"+token_2+"'");
RETURN (1);
ENDIF;
ENDON_ERROR;
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
vi$info ("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);
vi$info ("[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$info (token_2 +
' exists - use "' +
token_1 +
'! ' +
token_2 +
'" to overwrite.');
RETURN (1);
ELSE
vi$info ("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$info ('Use "w!" to write partial buffer');
outf := "";
ELSE
outf := GET_INFO (CURRENT_BUFFER, "OUTPUT_FILE");
IF outf <> "" THEN
vi$info ("Writing out """+outf+"""");
outf := WRITE_FILE (whole_range, outf);
ELSE
vi$info ("Buffer has no output file!");
ENDIF;
ENDIF;
ELSE
IF (vi$can_write (CURRENT_BUFFER)) THEN
vi$info ("Writing out """+
GET_INFO (CURRENT_BUFFER, "NAME")+"""");
outf := WRITE_FILE (CURRENT_BUFFER);
ELSE
RETURN;
ENDIF
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;
!
! Check to see if a buffer is readonly or not.
!
PROCEDURE vi$can_write (buf)
LOCAL
bmode;
bmode := vi$getbufmode (buf);
IF (bmode) THEN
vi$info (FAO ("!AS is set readonly", GET_INFO (buf, "NAME")));
ENDIF;
RETURN (bmode = 0);
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;
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
POSITION (LINE_BEGIN);
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;
POSITION (LINE_BEGIN);
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$info (token_2 + " does not exist!");
ENDIF;
ELSE
vi$info ("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$info ("Don't understand filename: "+token_2);
ENDIF;
ENDON_ERROR;
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,
cbuf,
bang,
separ,
token_2,
token_3;
ON_ERROR
IF ERROR = TPU$_PARSEFAIL THEN
vi$info ("Don't understand filename given!");
RETURN (1);
ENDIF;
ENDON_ERROR;
bang := vi$parse_next_ch (i, cmd, "!");
buf := 0;
cbuf := CURRENT_BUFFER;
token_2 := vi$skip_separ (cmd, i, vi$_space_tab, separ);
token_3 := vi$skip_separ (cmd, i, vi$_space_tab, separ);
IF (vi$rest_of_line (cmd, i) <> "") THEN
vi$info ("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
POSITION (cbuf);
IF (vi$check_auto_write) THEN
RETURN;
ENDIF;
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;
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$info ("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$info ("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 (bang);
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, 0);
IF (num <> 0) THEN
vi$beep_position (num, 1, 1);
vi$pos_in_middle (MARK (NONE));
ENDIF;
ENDIF;
ENDIF;
RETURN (1);
ENDPROCEDURE;
!
! Perform the EX mode messages command.
!
PROCEDURE vi$do_messages
vi$last_mapped := CURRENT_BUFFER;
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, bang);
vi$load_tags;
RETURN (vi$to_tag (tag_str, bang));
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 (vi$_space_tab, 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 (vi$_space_tab, 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, bang)
LOCAL
fname,
sch_pat,
tloc,
pos;
ON_ERROR
ENDON_ERROR;
pos := MARK (NONE);
! Read the symbol name from the CURRENT location in the buffer.
IF (tag = 0) THEN
tag := vi$sym_name;
ENDIF;
IF (tag = "") THEN
vi$info ("Bad tag name");
POSITION (pos);
RETURN (1);
ENDIF;
POSITION (BEGINNING_OF (vi$tag_buf));
IF (MARK (NONE) = END_OF (vi$tag_buf)) THEN
vi$info ("NO tags file!");
POSITION (pos);
RETURN (1);
ENDIF;
vi$global_var := 0;
EXECUTE (COMPILE ("vi$global_var := LINE_BEGIN & '"+tag+ASCII(9)+"'"));
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 (NOT bang) AND (vi$check_auto_write) THEN
RETURN (1);
ENDIF;
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));
vi$info ("Tag not found!");
$$EOD$$
More information about the Comp.sources.misc
mailing list