v04i103: TPUVI for VMS part 12 of 17
Gregg Wonderly
gregg at a.cs.okstate.edu
Tue Sep 27 11:57:50 AEST 1988
Posting-number: Volume 4, Issue 103
Submitted-by: "Gregg Wonderly" <gregg at a.cs.okstate.edu>
Archive-name: vms-vi-2/Part12
$ WRITE SYS$OUTPUT "Creating ""VI.8"""
$ CREATE VI.8
$ DECK/DOLLARS=$$EOD$$
RETURN (1);
ENDIF;
vi$pos_in_middle (MARK (NONE));
ENDIF;
ELSE
POSITION (pos);
vi$info ("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 = ASCII (9));
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$info ("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;
MESSAGE ("");
ELSE
vi$info ("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$info ("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
vi$info ("Can't unmap all windows that are mapped to """ +
buffer_name + """!");
RETURN (1);
ENDIF;
ELSE
win := GET_INFO (WINDOWS, "NEXT");
ENDIF;
ENDLOOP;
ELSE
vi$info ("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
vi$info ("Buffer NOT deleted!");
RETURN (1);
ENDIF;
ENDIF;
DELETE (loop_buffer);
vi$info ("Buffer, """+buffer_name+""", deleted!");
ELSE
vi$info ("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,
tend,
spos,
beg;
IF (leftm = 0) THEN
leftm := 1;
ENDIF;
IF (rightm = 0) THEN
rightm := vi$scr_width - vi$wrap_margin;
ENDIF;
POSITION (BEGINNING_OF (rng));
LOOP
EXITIF (CURRENT_CHARACTER <> " ") AND (CURRENT_CHARACTER <> ASCII (9));
MOVE_HORIZONTAL (1);
EXITIF (MARK (NONE) = END_OF (rng));
ENDLOOP;
beg := MARK (NONE);
POSITION (END_OF (rng));
MOVE_HORIZONTAL (-1);
tend := MARK (NONE);
rng := CREATE_RANGE (beg, tend, 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);
key := INT (key);
IF (key < 32) THEN
key := ((INT(CTRL_B_KEY) - INT(CTRL_A_KEY)) *
(key - 1)) + INT(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$info ("You can't redefine that key!");
RETURN (1);
ENDIF;
vi$global_var := 0;
buf := 0;
! The callable TPU interface can create certain problems, as it
! may cause the key definitions to hang around when the map
! buffers have actually been deleted. Mail can do this! As a
! result, the following code detects when the map buffer is
! missing, and creates a new one. The original meaning of
! any key that is mapped in this way is necessarily lost.
IF comment_string = "active_macro" THEN
EXECUTE (COMPILE ("vi$global_var := vi$$key_map_buf_" +
keyn + map_type + ";"));
buf := vi$global_var;
! If buf is zero at this point, then the key map buffer
! has been deleted.
ELSE
EXECUTE (COMPILE (
"vi$global_var := vi$init_buffer ('vi$$key_map_" +
keyn + map_type + "', '');"));
IF (vi$global_var = 0) THEN
vi$info ("Can't create buffer for key map!");
RETURN;
ENDIF;
EXECUTE (COMPILE ("vi$$key_map_buf_" +
keyn + map_type + " := vi$global_var;"));
! Pass the flag.
buf := 1;
ENDIF;
! New key map, save old map into keymap buffer.
IF (GET_INFO (buf, "TYPE") = INTEGER) THEN
buf := vi$global_var;
pos := MARK (NONE);
POSITION (buf);
SPLIT_LINE;
COPY_TEXT (comment_string);
ELSE
! Old map should be erased first.
IF (GET_INFO (buf, "TYPE") = BUFFER) THEN
pos := MARK (NONE);
POSITION (BEGINNING_OF (buf));
LOOP
EXITIF (CURRENT_LINE = "");
ERASE_LINE;
ENDLOOP;
ELSE
! Key map buffer has been deleted, create a new one.
EXECUTE (COMPILE (
"vi$global_var := vi$init_buffer ('vi$$key_map_" +
keyn + map_type + "', '');"));
IF (vi$global_var = 0) THEN
vi$info ("Can't create buffer for key map!");
RETURN;
ENDIF;
EXECUTE (COMPILE ("vi$$key_map_buf_" +
keyn + map_type + " := vi$global_var;"));
buf := vi$global_var;
pos := MARK (NONE);
POSITION (buf);
SPLIT_LINE;
COPY_TEXT ("vi$lost_definition");
ENDIF;
ENDIF;
POSITION (BEGINNING_OF (buf));
LOOP
EXITIF (i > LENGTH (cmd));
COPY_TEXT (STR (INT (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 + ")', KEY_NAME(" + STR(key) + "), 'active_macro', vi$edit_keys);"));
ELSE
EXECUTE (COMPILE ("DEFINE_KEY ('vi$do_macro (vi$$key_map_buf_" + keyn +
map_type + ", 1)', KEY_NAME(" + 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$info ("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$info ("Key not currently mapped!");
RETURN;
ENDIF;
key := INT (key);
IF (key < 32) THEN
key := ((INT(CTRL_B_KEY) - INT(CTRL_A_KEY)) *
(key - 1)) + INT(CTRL_A_KEY);
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_success_on;
POSITION (pos);
DELETE (buf);
vi$info ("Key now unmapped!");
ENDPROCEDURE;
!
!
!
PROCEDURE vi$lost_definition
vi$info ("Key definition lost!");
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)
LOCAL
k;
k := key;
IF (GET_INFO (key, "TYPE") = KEYWORD) THEN
k := INT (key);
ENDIF;
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 (vi$_space_tab, 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 := 0;
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
vi$info ("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, 0);
IF (num <> 0) THEN
num := BEGINNING_OF (num);
POSITION (num);
num := vi$cur_line_no;
ELSE
RETURN (-1);
ENDIF;
ELSE
IF (ch = "'") THEN
ch := SUBSTR (cmd, idx+1, 1);
idx := idx + 2;
vi$global_var := 0;
EXECUTE (COMPILE ("vi$global_var:=vi$mark_"+ch));
IF (vi$global_var <> 0) THEN
POSITION (vi$global_var);
num := vi$cur_line_no;
ELSE
RETURN (-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;
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 = ASCII (9)) 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,
doglobal,
replace,
separ;
idx := 1;
separ := vi$next_char (cmd, idx);
source := "";
dest := "";
doglobal := 0;
query := 0;
LOOP
IF (idx > LENGTH (cmd)) THEN
vi$info ("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") or (ch = "c") THEN
query := 1;
ELSE
IF ch = "g" THEN
doglobal := 1;
ELSE
vi$info ("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, doglobal, 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,
doglobal,
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 := "";
doglobal := 0;
query := 0;
LOOP
IF (idx > LENGTH (cmd)) THEN
vi$info ("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") OR (ch = "c") THEN
query := 1;
ELSE
IF ch = "g" THEN
doglobal := 1;
ELSE
vi$info ("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;
scount := 0;
lpos := vi$perform_subs (source, dest, end_line, scount, doglobal, 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);
vi$info (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,
doglobal,
query,
lpos,
spos,
pos,
epos,
here;
IF (vi$replace_separ = 0) THEN
vi$info ("No previous substitution!");
RETURN;
ENDIF;
doglobal := 0;
query := 0;
here := vi$cur_line_no;
vi$save_for_undo (CURRENT_LINE, VI$LINE_MODE, 1);
pos := MARK (NONE);
POSITION (LINE_BEGIN);
spos := vi$get_undo_start;
POSITION (LINE_END);
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, doglobal, 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;
RETURN (lpos);
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, doglobal, 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, 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;
replace := 1;
ENDIF;
ENDIF;
IF replace THEN
! This is a hack necessary to fix TPU's pattern matching.
! The length of the text matched by only "line_begin" and
! "line_end" has length == 1 instead of 0 as one would expect.
IF (source <> "^") AND (source <> "$") AND (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 doglobal THEN
POSITION (LINE_BEGIN);
EXITIF MARK (NONE) = END_OF (CURRENT_BUFFER);
MOVE_VERTICAL (1);
ENDIF;
EXITIF quit_now;
ENDLOOP;
IF fcnt = 0 THEN
vi$info ("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
vi$global_var := 0;
IF INT(cur_char) > 1 THEN
EXECUTE (COMPILE ("vi$global_var := SUBSTR (p" +
cur_char +", LENGTH (o"+cur_char+")+1,512);"));
ELSE
EXECUTE (COMPILE ("vi$global_var := SUBSTR (p" +
cur_char +", LENGTH (o"+cur_char+"),512);"));
ENDIF;
result := result + vi$global_var;
ELSE
IF (cur_char = "&") THEN
result := result + cur_char;
ELSE
result := result + "\" + cur_char;
ENDIF;
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, "= "+ASCII(9), 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;
vi$info ("ERROR at line: "+STR(ERROR_LINE)+", "+
call_user(vi$cu_getmsg,STR(errno)));
RETURN (1);
ENDON_ERROR;
token_2 := "";
a 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 = "empty") THEN
vi$delete_empty := 0;
RETURN (0);
ENDIF;
IF (token_1 = "noempty") THEN
vi$delete_empty := 1;
RETURN (0);
ENDIF;
IF (token_1 = "files") OR (token_1 = "file") THEN
val := vi$expand_file_list (vi$rest_of_line (cmd, i));
vi$info (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 = "noreadonly") OR (token_1 = "noro") THEN
SET (NO_WRITE, CURRENT_BUFFER, OFF);
vi$setbufmode (CURRENT_BUFFER, 0);
vi$status_lines (CURRENT_BUFFER);
RETURN (0);
ENDIF;
IF (token_1 = "readonly") OR (token_1 = "ro") THEN
vi$setbufmode (CURRENT_BUFFER, 1);
vi$status_lines (CURRENT_BUFFER);
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, "= "+ASCII(9), 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, "= "+ASCII(9), 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, "= "+ASCII(9), 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, "= "+ASCII(9), separ);
vi$shift_width := INT (token_2);
RETURN (0);
ENDIF;
IF (token_1 = "noautoindent") OR (token_1 = "noai") THEN
vi$auto_indent := 0;
RETURN (0);
ENDIF;
IF (token_1 = "autoindent") OR (token_1 = "ai") THEN
vi$auto_indent := 1;
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, "= "+ASCII(9), separ);
vi$how_much_scroll := INT (token_2);
RETURN (0);
ENDIF;
IF (token_1 = "report") THEN
token_2 := vi$skip_separ (cmd, i, "= "+ASCII(9), 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;
$$EOD$$
More information about the Comp.sources.misc
mailing list