gregg@a.cs.okstate.edu (Gregg Wonderly) (10/21/87)
$!=============================================================================
$! VAX/VMS archive file created by VMS_SHAR V-4.03 05-Aug-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by GREGG
$! on Tuesday 20-OCT-1987 22:43:20.53
$!
$! It contains the following 1 file:
$! VI.6
$!=============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set (Output_File,b,o);
Position (Beginning_of(b));Loop x:=Erase_Character(1); Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;Move_Horizontal
(-Current_Offset);EndLoop;Move_Vertical(1);ExitIf Mark(None)=End_of(b)
EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="VI.6"
$ Check_Sum_is=185770979
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X ENDIF;
X ELSE
X regular := 1;
X ENDIF;
X
X IF (regular) THEN
X new_pat := new_pat + cur_pat;
X ELSE
X IF new_pat = "" THEN
X new_pat := cur_pat;
X ELSE
X new_pat := new_pat + "&" + cur_pat;
X ENDIF;
X ENDIF;
X
X pos := pos + 1;
X
X ENDLOOP;
X
X RETURN (new_pat);
XENDPROCEDURE;
X!
X!
X! TPU pattern generator. Generates a pattern string from the passed
X! RE string. The function is used when :set magic is in effect.
X!
XPROCEDURE vi$re_pattern_gen (pat)
X
X LOCAL
X first, ! First pattern to be done
X part_pat,
X chno,
X startchar,
X haveany,
X regular,
X tstr,
X endchar,
X pat_str,
X str_pat,
X cur_pat, ! The current pattern to be extracted
X cur_char, ! The current character in the regular
X ! expression being examined
X new_pat, ! The output pattern
X in_ws,
X pos; ! The position within the regular
X ! expression string that we are examining
X ! currently
X
X vi$in_ws := 0;
X IF ((INDEX (pat, "$") <> 0) OR (INDEX (pat, "[") <> 0) OR
X (INDEX (pat, "^") <> 0) OR (INDEX (pat, ".") <> 0) OR
X (INDEX (pat, "*") <> 0) OR (INDEX (pat, "\") <> 0) OR
X (INDEX (pat, '"') <> 0)) THEN
X new_pat := "";
X ELSE
X new_pat := '"'+pat+'"';
X RETURN (new_pat);
X ENDIF;
X
X in_ws := 0;
X pos := 1;
X
X IF SUBSTR (pat, pos, 1) = "^" THEN
X new_pat := "line_begin";
X pos := pos + 1;
X ENDIF;
X
X LOOP
X EXITIF (pos > LENGTH (pat));
X
X regular := 0;
X cur_pat := "";
X cur_char := substr (pat, pos, 1);
X pat_str := "";
X
X IF (cur_char = "$") THEN
X IF (pos+1 >= LENGTH (pat)) THEN
X cur_pat := "line_end";
X ELSE
X vi$message ("$ found before end of string");
X RETURN (0);
X ENDIF;
X ELSE
X IF cur_char = "[" THEN
X pos := pos + 1;
X
X IF SUBSTR (pat, pos, 1) = "^" THEN
X pos := pos + 1;
X part_pat := "notany('";
X ELSE
X part_pat := "any('";
X ENDIF;
X
X LOOP
X EXITIF pos > LENGTH (pat);
X EXITIF SUBSTR (pat, pos, 1) = "]";
X
X IF SUBSTR (pat, pos, 1) = "\" THEN
X pos := pos + 1;
X IF pos > LENGTH (pat) THEN
X vi$message ("Missing character after \");
X RETURN ("");
X ENDIF;
X ENDIF;
X
X startchar := SUBSTR (pat, pos, 1);
X pat_str := pat_str + startchar;
X IF startchar = "'" THEN
X pat_str := pat_str + "'";
X ENDIF;
X
X IF (SUBSTR (pat, pos+1, 1) = '-') THEN
X pos := pos + 2;
X IF (pos >= LENGTH (pat)) THEN
X vi$message ("Missing character after '-'");
X RETURN ("");
X ENDIF;
X
X endchar := SUBSTR (pat, pos, 1);
X
X chno := 1;
X LOOP
X EXITIF (ASCII(chno) = startchar);
X chno := chno + 1;
X ENDLOOP;
X
X LOOP
X chno := chno + 1;
X IF (chno > 255) THEN
X vi$message (
X "Invalid character sequence for '-'");
X RETURN ("");
X ENDIF;
X
X EXITIF (ASCII (chno-1) = endchar);
X pat_str := pat_str + ASCII (chno);
X IF ASCII (chno) = "'" THEN
X pat_str := pat_str + "'";
X ENDIF;
X ENDLOOP;
X ENDIF;
X pos := pos + 1;
X ENDLOOP;
X
X IF pat_str = "" THEN
X vi$message ("No text found between []");
X RETURN ("");
X ENDIF;
X
X IF (SUBSTR (pat, pos+1, 1) = "*") THEN
X IF (part_pat = "notany('") THEN
X cur_pat := cur_pat + "(scan('"+pat_str+"')|"""")";
X ELSE
X cur_pat := cur_pat + "(span('"+pat_str+"')|"""")";
X ENDIF;
X pos := pos + 1;
X ELSE
X cur_pat := part_pat + pat_str + "')";
X ENDIF;
X ELSE
X
X tstr := '"';
X haveany := 0;
X regular := 1;
X
X LOOP
X cur_char := SUBSTR (pat, pos, 1);
X EXITIF (cur_char = "^") OR (cur_char = "[") OR
X (cur_char = "$");
X EXITIF (pos > LENGTH (pat));
X
X IF cur_char = "\" THEN
X pos := pos + 1;
X startchar := SUBSTR (pat, pos, 1);
X IF (startchar = "<") THEN
X in_ws := 1;
X vi$in_ws := 1;
X tstr := tstr + '"&(line_begin | any (vi$_ws))&"';
X ELSE
X IF (startchar = ">") THEN
X in_ws := 0;
V tstr := tstr + '"&(line_end | any (vi$_ws))&"'
X;
X ELSE
X tstr := tstr + startchar;
X ENDIF;
X ENDIF;
X ELSE
X IF (cur_char = ".") THEN
X cur_char := "longer_than_1";
X ENDIF;
X
X IF (SUBSTR (pat, pos+1, 1) = '*') THEN
X pos := pos + 1;
X
X IF (LENGTH (cur_char) > 1) THEN
X cur_pat := "''&(span(vi$pch)|'')";
X ELSE
X cur_pat := "(span('"+cur_char+"')|"""")";
X ENDIF;
X tstr := tstr+'"'+"&"+cur_pat+"&"+'"';
X haveany := 0;
X ELSE
X IF (LENGTH (cur_char) > 1) THEN
X IF (haveany) THEN
X tstr := tstr +'"'+"&"+"arb(1)"+"&"+'"';
X haveany := 0;
X ELSE
V IF (LENGTH (tstr)>0) and (tstr <> '"') THE
XN
V tstr := tstr +'"'+"&"+"arb(1)"+"&"+'"'
X;
X ELSE
X tstr := "arb(1)"+"&"+'"';
X ENDIF
X ENDIF;
X ELSE
X IF (cur_char = """") THEN
X tstr := tstr + '""';
X haveany := haveany + 2;
X ELSE
X tstr := tstr + cur_char;
X haveany := haveany + 1;
X ENDIF;
X ENDIF;
X ENDIF;
X ENDIF;
X pos := pos + 1;
X ENDLOOP;
X cur_pat := tstr + '"';
X pos := pos - 1;
X ENDIF;
X ENDIF;
X
X IF (regular) THEN
X IF new_pat = "" THEN
X new_pat := cur_pat;
X ELSE
X IF (LENGTH (tstr) > 1) THEN
X new_pat := new_pat + "&" + cur_pat;
X ENDIF;
X ENDIF;
X ELSE
X IF new_pat = "" THEN
X new_pat := cur_pat;
X ELSE
X new_pat := new_pat + "&" + cur_pat;
X ENDIF;
X ENDIF;
X pos := pos + 1;
X
X ENDLOOP;
X
X IF (in_ws) THEN
X MESSAGE ("Missing \> in pattern!");
X RETURN (0);
X ENDIF;
X
X RETURN (new_pat);
XENDPROCEDURE;
X
X!
X! Match brackets when '%' is typed.
X!
XPROCEDURE vi$_match_brackets
X vi$position (vi$match_brackets, 1);
XENDPROCEDURE;
X
X!
X! Perform the actual match bracket operation.
X!
XPROCEDURE vi$match_brackets
X LOCAL
X newpos,
X ind_pos,
X found,
X cur_ch,
X cur_dir,
X pos;
X
X ON_ERROR
X IF ERROR = TPU$_CONTROLC THEN
X vi$beep;
X vi$pasthru_on;
X RETURN (0);
X ENDIF;
X ENDON_ERROR;
X
X found := 1;
X vi$message ("");
X pos := MARK (NONE);
X cur_ch := CURRENT_CHARACTER;
X ind_pos := INDEX (vi$bracket_chars, cur_ch);
X
X IF (ind_pos = 0) THEN
X newpos := SEARCH (ANCHOR & SCAN (")") & ARB (1), FORWARD, EXACT);
X found := 0;
X IF newpos <> 0 THEN
X found := 1;
X IF vi$in_show_match = 0 THEN
X vi$old_place := pos;
X ENDIF;
X POSITION (END_OF (newpos));
X RETURN (vi$retpos (pos));
X ELSE
X POSITION (pos);
X RETURN (0);
X ENDIF;
X ENDIF;
X
X IF ((ind_pos/2)*2 <> ind_pos) THEN
X cur_dir := FORWARD;
X ELSE
X cur_dir := REVERSE;
X ENDIF;
X
X SET (TIMER, ON, "Searching...");
X newpos := vi$do_match (CURRENT_CHARACTER, cur_dir, 0);
X SET (TIMER, OFF);
X
X IF (GET_INFO (newpos, "TYPE") = MARKER) THEN
X RETURN (vi$retpos (pos));
X ELSE
X IF (newpos = 0) AND NOT (vi$in_show_match) THEN
X vi$message ("No matching bracket");
X ENDIF;
X POSITION (pos);
X ENDIF;
X RETURN (0);
XENDPROCEDURE;
X!
X!
X! This procedure knows how to traverse nested brackets to find the matching
X! bracket. It takes the character that the cursor is positioned on, and
X! finds the matching one. It recognizes '{}', '[]', '()' pairs.
X!
XPROCEDURE vi$do_match (bracket, cur_dir, level)
X
X LOCAL
X dgrp,
X dest_char,
X sel_reg,
X ind_pos,
X next_pos,
X possibles,
X cur_ch;
X
X ON_ERROR
X RETURN (0);
X ENDON_ERROR;
X
X IF level > 30 THEN
X vi$message ("Too many nested levels");
X RETURN (-1);
X ENDIF;
X
X ! Identify the desired search direction based on the character.
X
X ind_pos := INDEX (vi$bracket_chars, bracket);
X dest_char := SUBSTR ("}{)(][", ind_pos, 1);
X
X IF cur_dir = FORWARD THEN
X MOVE_HORIZONTAL (1);
X ENDIF;
X
X dgrp := bracket + dest_char;
X LOOP
X sel_reg := SEARCH (ANY (dgrp), cur_dir, EXACT);
X
X IF sel_reg = 0 THEN
X RETURN (0);
X ENDIF;
X
X POSITION (BEGINNING_OF (sel_reg));
X
X IF (CURRENT_CHARACTER = dest_char) THEN
X RETURN (MARK (NONE));
X ELSE
X IF (((INDEX ("([{", CURRENT_CHARACTER) <> 0) AND
X (cur_dir = FORWARD)) OR
X ((INDEX (")}]", CURRENT_CHARACTER) <> 0) AND
X (cur_dir = REVERSE))) THEN
X
X IF (INDEX (vi$bracket_chars, CURRENT_CHARACTER)-1)/2 <=
X (INDEX (vi$bracket_chars, dest_char)-1)/2 THEN
X
X next_pos := vi$do_match (CURRENT_CHARACTER,
V cur_dir, level+1
X);
X
X IF (next_pos <> 0) AND (next_pos <> -1) THEN
X POSITION (next_pos);
X ELSE
X RETURN (next_pos);
X ENDIF;
X ENDIF;
X ELSE
X IF (INDEX (vi$bracket_chars, CURRENT_CHARACTER) = 0) THEN
X vi$message ("Unknown bracket character: '"+
X CURRENT_CHARACTER+"'");
X RETURN (-1);
X ENDIF;
X ENDIF;
X
X IF cur_dir = FORWARD THEN
X MOVE_HORIZONTAL (1);
X ENDIF;
X ENDIF;
X ENDLOOP;
XENDPROCEDURE;
X
X!
X! Move to the top line of the window when 'H' is pressed.
X!
XPROCEDURE home
X POSITION (vi$to_home);
XENDPROCEDURE;
X
X!
X! Perform the actual movement for the 'H' command and return the marker.
X!
XPROCEDURE vi$to_home
X
X LOCAL
X pos;
X
X ON_ERROR
X ! Ignore attempt to move beyond end of buffer errors.
X ENDON_ERROR;
X
X pos := MARK (NONE);
X MOVE_VERTICAL ( GET_INFO (CURRENT_WINDOW, "VISIBLE_TOP") -
X GET_INFO (CURRENT_WINDOW, "CURRENT_ROW"));
X
X vi$yank_mode := VI$LINE_MODE;
X RETURN (vi$retpos(pos));
XENDPROCEDURE
X
X!
X! Position the cursor into the middle of the current window when 'M' is
X! pressed.
X!
XPROCEDURE vi$middle
X POSITION (vi$to_middle);
XENDPROCEDURE;
X
X!
X! Perform the actual movement of the 'M' command.
X!
XPROCEDURE vi$to_middle
X
X LOCAL
X len,
X cur,
X top,
X pos;
X
X ON_ERROR
X ! Ignore attempt to move beyond end of buffer errors.
X ENDON_ERROR;
X
X pos := MARK (NONE);
X
X len := GET_INFO (CURRENT_WINDOW, "VISIBLE_LENGTH");
X cur := GET_INFO (CURRENT_WINDOW, "CURRENT_ROW");
X top := GET_INFO (CURRENT_WINDOW, "VISIBLE_TOP");
X
X MOVE_VERTICAL (((len-top+1)/2) - (cur - top + 1));
X
X vi$yank_mode := VI$LINE_MODE;
X RETURN (vi$retpos(pos));
XENDPROCEDURE;
X
X!
X! Move the the last line of the current window when 'L' is pressed.
X!
XPROCEDURE vi$last
X POSITION (vi$to_last);
XENDPROCEDURE;
X
X!
X! Perform the actual movement associated with the 'L' command.
X!
XPROCEDURE vi$to_last
X
X LOCAL
X pos;
X
X ON_ERROR
X ! Ignore attempt to move beyond end of buffer errors.
X ENDON_ERROR;
X
X pos := MARK (NONE);
X MOVE_VERTICAL ( GET_INFO (CURRENT_WINDOW, "VISIBLE_BOTTOM") -
X GET_INFO (CURRENT_WINDOW, "CURRENT_ROW"));
X
X vi$yank_mode := VI$LINE_MODE;
X RETURN (vi$retpos (pos));
XENDPROCEDURE
X
X!
X! Move to the end of the current line when '$' is pressed.
X!
XPROCEDURE vi$_eol
X POSITION (vi$eol);
XENDPROCEDURE;
X
X!
X! Perform the actual movement associated with the '$' command.
X!
XPROCEDURE vi$eol
X LOCAL
X pos;
X
X ON_ERROR
X RETURN (pos);
X ENDON_ERROR;
X
X pos := MARK (NONE);
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X MOVE_HORIZONTAL (LENGTH (vi$current_line));
X vi$check_rmarg;
X
X vi$yank_mode := VI$IN_LINE_MODE;
X RETURN (vi$retpos (pos));
XENDPROCEDURE;
X
X!
X! Move the first non-blank character of the line when '^' is typed.
X!
XPROCEDURE vi$_bol
X vi$position (vi$first_no_space, 0);
XENDPROCEDURE;
X
X!
X! Move the beginning of the line when '0' is typed.
X!
XPROCEDURE vi$fol
X LOCAL
X pos;
X
X pos := MARK (NONE);
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X vi$yank_mode := VI$IN_LINE_MODE;
X vi$new_offset := 1;
X RETURN (vi$retpos (pos));
XENDPROCEDURE;
X
X!
X! Move the the location searched for.
X!
XPROCEDURE vi$_search (direction)
X LOCAL
X pos;
X
X pos := vi$search(direction);
X
X vi$position (pos, 1);
X IF (pos <> 0) THEN
X vi$pos_in_middle (MARK (NONE));
X ENDIF;
XENDPROCEDURE;
X
X!
X! Move to the next location of the string previously searched for.
X!
XPROCEDURE vi$_search_next (direction)
X LOCAL
X pos;
X
X pos := vi$search_next(direction);
X
X vi$position (pos, 1);
X IF (pos <> 0) THEN
X vi$pos_in_middle (MARK (NONE));
X ENDIF;
XENDPROCEDURE;
X
X!
X! Repeat the last 't' or 'f' command backwards.
X!
XPROCEDURE vi$_repeat_torf_back
X vi$position (vi$repeat_torf_back, 0);
XENDPROCEDURE
X
X!
X! Repeat the last 't' or 'f' command.
X!
XPROCEDURE vi$_repeat_torf
X vi$position (vi$repeat_torf, 0);
XENDPROCEDURE
X
X!
X! Return the location found by repeating the last 't', 'f', 'T' or 'F'
X! command backwards.
X!
XPROCEDURE vi$repeat_torf_back
X LOCAL
X old_func,
X back_func;
X
X IF vi$last_s_func = 0 THEN
X RETURN (0);
X ENDIF;
X
X old_func := vi$last_s_func;
X IF (vi$last_s_func = "vi$back_find_char") THEN
X back_func := "vi$find_char";
X ENDIF;
X IF (vi$last_s_func = "vi$find_char") THEN
X back_func := "vi$back_find_char";
X ENDIF;
X IF (vi$last_s_func = "vi$back_to_char") THEN
X back_func := "vi$to_char";
X ENDIF;
X IF (vi$last_s_func = "vi$to_char") THEN
X back_func := "vi$back_to_char";
X ENDIF;
X
X vi$global_var := 0;
X EXECUTE (COMPILE (
X "vi$global_var := " + back_func + "('"+vi$last_s_char + "')"));
X vi$last_s_func := old_func;
X RETURN (vi$global_var);
XENDPROCEDURE
X
X!
X! Return the location found by repeating the last 't', 'f', 'T' or 'F'
X! command.
X!
XPROCEDURE vi$repeat_torf
X IF vi$last_s_func = 0 THEN
X RETURN (0);
X ENDIF;
X
X vi$global_var := 0;
X EXECUTE (COMPILE (
X "vi$global_var := " + vi$last_s_func + "('"+vi$last_s_char + "')"));
X RETURN (vi$global_var);
XENDPROCEDURE
X
X!
X! Return the value of a positive integer that is represented as a string.
X! If the string is not a valid integer, then -1 is retured.
X!
XPROCEDURE vi$number_from_string (str_num)
X ON_ERROR
X RETURN (-1);
X ENDON_ERROR;
X
X RETURN (INT (str_num));
XENDPROCEDURE;
X
X!
X! Move to the line indicated by 'line_no', and return the marker that
X! indicates the beginning of that line.
X!
XPROCEDURE vi$mark_line (line_no)
X
X LOCAL
X pos;
X
X ON_ERROR
X POSITION (pos);
X RETURN (0);
X ENDON_ERROR;
X
X pos := MARK (NONE);
X POSITION (BEGINNING_OF (CURRENT_BUFFER));
X MOVE_VERTICAL (line_no - 1);
X RETURN (vi$retpos (pos));
XENDPROCEDURE;
X
X!
X! Perform an EX mode command after a ':' is typed.
X!
XPROCEDURE vi$ex_mode
X LOCAL
X cmd_str;
X
X IF (vi$read_a_line (":", cmd_str) <> 0) and (cmd_str <> "") THEN
X IF (vi$do_cmd_line (cmd_str) = 0) THEN
X vi$message ("");
X ENDIF;
X ENDIF;
XENDPROCEDURE;
X
X!
X!
X!
XPROCEDURE vi$read_a_line (prompt, cmd_str)
X LOCAL
X cmd_idx,
X addch,
X ch,
X did_ctl_v,
X win,
X pos;
X
X win := CURRENT_WINDOW;
X pos := MARK (NONE);
X
X POSITION (END_OF (command_buffer));
X MAP (command_window, command_buffer);
X COPY_TEXT (prompt);
X SET (OVERSTRIKE, CURRENT_BUFFER);
X
X cmd_str := "";
X cmd_idx := 0;
X LOOP
X vi$update (CURRENT_WINDOW);
X ch := vi$read_a_key;
X
X did_ctl_v := 0;
X IF ch = CTRL_V_KEY THEN
X COPY_TEXT ("^");
X did_ctl_v := 1;
X MOVE_HORIZONTAL (-1);
X vi$update (CURRENT_WINDOW);
X ch := vi$read_a_key;
X ERASE_CHARACTER (1);
X ENDIF;
X
X EXITIF ((ch = RET_KEY) OR (ch = F11)) AND (did_ctl_v = 0);
X
X IF (ch = RET_KEY) THEN ch := CTRL_M_KEY; ENDIF;
X IF (ch = F12) THEN ch := CTRL_H_KEY; ENDIF;
X IF (ch = F11) THEN ch := KEY_NAME (ASCII (27)); ENDIF;
X
X IF ((ch = DEL_KEY) OR (ch = CTRL_H_KEY)) AND (did_ctl_v = 0) THEN
X IF cmd_idx = 0 THEN
X UNMAP (command_window);
X UNMAP (message_window);
X MAP (message_window, message_buffer);
X POSITION (win);
X POSITION (pos);
X RETURN (0);
X ENDIF;
X ch := SUBSTR (cmd_str, cmd_idx, 1);
X cmd_idx := cmd_idx - 1;
X IF (INDEX (vi$_ctl_chars, ch) <> 0) THEN
X MOVE_HORIZONTAL (-2);
X ELSE
X MOVE_HORIZONTAL (-1);
X ENDIF;
X cmd_str := SUBSTR (cmd_str, 1, cmd_idx);
X ELSE
X IF (ch <= KEY_NAME (ASCII (31))) AND (ch >= CTRL_A_KEY) THEN
X IF ch = TAB_KEY THEN
X addch := 9;
X COPY_TEXT (ASCII(addch));
X ELSE
X addch := ((ch - CTRL_A_KEY) / 256) + 1;
X COPY_TEXT ("^");
X COPY_TEXT (ASCII (addch + 64));
X ENDIF;
X cmd_str := cmd_str + ASCII (addch);
X cmd_idx := cmd_idx + 1;
X IF ch = 27 THEN ch := F11; ENDIF;
X ELSE
X IF (ch = UP) THEN
X vi$next_in_cmd (cmd_str, cmd_idx, prompt, -1);
X ELSE
X IF (ch = DOWN) THEN
X vi$next_in_cmd (cmd_str, cmd_idx, prompt, 1);
X ELSE
X COPY_TEXT (ASCII(ch));
X cmd_str := cmd_str + ASCII (ch);
X cmd_idx := cmd_idx + 1;
X ENDIF;
X ENDIF;
X ENDIF;
X ENDIF;
X ENDLOOP;
X
X ERASE_CHARACTER (LENGTH (CURRENT_LINE) - CURRENT_OFFSET);
X
X POSITION (END_OF (command_buffer));
X LOOP
X MOVE_VERTICAL (-1);
X EXITIF (CURRENT_LINE <> prompt);
X ERASE_LINE;
X ENDLOOP;
X
X IF (CURRENT_LINE <> prompt + cmd_str) THEN
X MOVE_VERTICAL (1);
X COPY_TEXT (prompt + cmd_str);
X ENDIF;
X
X UNMAP (command_window);
X UNMAP (message_window);
X MAP (message_window, message_buffer);
X
X POSITION (win);
X POSITION (pos);
X
X RETURN (1);
XENDPROCEDURE;
X
X!
X! This procedure looks from the next occurence of 'prompt' at the
X! beginning of the line, in the direction dir (1 or -1). If prompt
X! is found, then cmd_str is set to the contents of that line, minus
X! the text of the prompt, and cmd_idx is set to the length of cmd_str.
X! The cursor is left positioned at the end of the line found, or if
X! none is found, it is not moved.
X!
XPROCEDURE vi$next_in_cmd (cmd_str, cmd_idx, prompt, dir)
X LOCAL
X pos,
X len;
X
X ON_ERROR
X POSITION (pos);
X RETURN;
X ENDON_ERROR;
X
X pos := MARK (NONE);
X len := LENGTH (prompt);
X
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X LOOP
X EXITIF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) AND (dir = -1);
X EXITIF (MARK (NONE) = END_OF (CURRENT_BUFFER)) AND (dir = 1);
X MOVE_VERTICAL (DIR);
X IF SUBSTR (CURRENT_LINE, 1, len) = prompt THEN
X cmd_str := SUBSTR (CURRENT_LINE, len+1,
X LENGTH (CURRENT_LINE) - len + 1);
X cmd_idx := LENGTH (cmd_str);
X MOVE_HORIZONTAL (LENGTH (CURRENT_LINE));
X RETURN;
X ENDIF;
X ENDLOOP;
X POSITION (pos);
XENDPROCEDURE;
X
X!
X! Perform a whole series of command separated by '|'s.
X!
XPROCEDURE vi$do_cmd_line (cmd)
X LOCAL
X ch,
X retval,
X idx,
X strg;
X
X idx := 1;
X strg := "";
X
X LOOP
X EXITIF (idx > LENGTH (cmd));
X ch := SUBSTR (cmd, idx, 1);
X IF (ch = "|") THEN
X retval := vi$do_command (strg);
X IF (retval > 1) THEN
X RETURN (retval);
X ELSE
X IF (retval = 0) THEN
X MESSAGE ("");
X ENDIF;
X ENDIF;
X strg := 0;
X ELSE
X IF (ch = "\") THEN
X idx := idx + 1;
X IF (SUBSTR (cmd, idx, 1) = "|") THEN
X strg := strg + "|";
X ELSE
X strg := strg + "\" + SUBSTR (cmd, idx, 1);
X ENDIF;
X ELSE
X strg := strg + ch;
X ENDIF;
X ENDIF;
X idx := idx + 1;
X ENDLOOP;
X
X IF (strg <> 0) THEN
X IF (vi$do_command (strg) <> 0) THEN
X RETURN (1);
X ELSE
X MESSAGE ("");
X ENDIF;
X ENDIF;
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Perform an EX (not all are implemented) command as given in "cmd".
X!
XPROCEDURE vi$do_command (cmd)
X LOCAL
X rng,
X outf,
X mode,
X token_1,
X token_2,
X token_3,
X res_spec,
X start_mark,
X end_mark,
X start_line,
X end_line,
X work_range,
X whole_range,
X buf,
X pos,
X spos,
X rest,
X separ,
X no_spec,
X ch,
X i,
X j,
X olen,
X bang,
X num,
X pos;
X
X olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
X
X ! Start at beginning of string and look for a range of lines.
X
X i := 1;
X
X pos := MARK (NONE);
X num := vi$get_line_spec (i, cmd);
X
X no_spec := 0;
X IF (num < 0) THEN
X IF (vi$parse_next_ch (i, cmd, "%")) THEN
X start_line := 1;
X end_line := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
X ELSE
X no_spec := 1;
X start_line := vi$cur_line_no;
X end_line := start_line;
X ENDIF;
X ELSE
X start_line := num;
X IF (vi$parse_next_ch (i, cmd, ",")) THEN
X num := vi$get_line_spec (i, cmd);
X IF (num < 0) THEN
X vi$message ("Invalid line range specification!");
X RETURN (1);
X ENDIF;
X end_line := num;
X ELSE
X end_line := start_line;
X ENDIF;
X ENDIF;
X
X POSITION (pos);
X
X work_range := 0;
X whole_range := 0;
X
X IF (start_line > end_line) THEN
X vi$message ("Bad range of lines!");
X RETURN (1);
X ENDIF;
X
X start_mark := vi$mark_line (start_line);
X end_mark := vi$mark_line (end_line);
X
X IF (start_mark = 0) OR (end_mark = 0) THEN
X vi$message ("Bad range of lines!");
X RETURN (1);
X ENDIF;
X
X work_range := CREATE_RANGE (start_mark, end_mark, NONE);
X
X pos := MARK (NONE);
X POSITION (end_mark);
X
X IF (end_mark <> END_OF (CURRENT_BUFFER)) THEN
X MOVE_VERTICAL (1);
X ENDIF;
X
X IF (end_mark <> BEGINNING_OF (CURRENT_BUFFER)) THEN
X MOVE_HORIZONTAL (-1);
X ENDIF;
X
X whole_range := CREATE_RANGE (start_mark, MARK (NONE), NONE);
X POSITION (pos);
X
X ! If there is no command then move to the line indicated.
X
X rest := vi$rest_of_line (cmd, i);
X EDIT (rest, COLLAPSE);
X IF rest = "" THEN
X vi$old_place := MARK (NONE);
X POSITION (start_mark);
X RETURN (0);
X ENDIF;
X
X token_1 := vi$get_cmd_token (vi$_lower_chars, cmd, i);
X
X IF (token_1 = "help") THEN
X RETURN (vi$do_help (vi$rest_of_line (cmd, i)));
X ENDIF;
X
X IF (token_1 = "show") THEN
X RETURN (vi$do_show (cmd, i));
X ENDIF;
X
X ! Check for substitution alias.
X
X IF (token_1 = "") AND (vi$parse_next_ch (i, cmd, "&")) THEN
X RETURN (vi$do_subs_alias (cmd, i, start_line, end_line, whole_range));
X ENDIF;
X
X IF (token_1 = "") AND (vi$parse_next_ch (i, cmd, "@")) THEN
X RETURN (vi$do_macro_buffer (cmd, i));
X ENDIF;
X
X IF (token_1 = "learn") THEN
X RETURN (vi$do_learn (cmd, i));
X ENDIF;
X
X IF (token_1 = "unlearn") THEN
X RETURN (vi$do_unlearn (cmd, i));
X ENDIF;
X
X IF (token_1 = "g") THEN
X RETURN (vi$do_global (cmd, i));
X ENDIF;
X
X IF (token_1 = "sh") OR (token_1 = "dcl") THEN
X RETURN (vi$spawn (0));
X ENDIF;
X
X IF (vi$leading_str (token_1, "unabbr") AND (LENGTH (token_1) > 4)) THEN
X RETURN (vi$do_unabbr (cmd, i));
X ENDIF;
X
X IF (vi$leading_str (token_1, "abbr") AND (LENGTH (token_1) > 3)) THEN
X RETURN (vi$do_abbr (cmd, i));
X ENDIF;
X
X IF (vi$leading_str (token_1, "edit")) OR
X (vi$leading_str (token_1, "vi")) THEN
X RETURN (vi$do_edit (cmd, i, token_1));
X ENDIF;
X
X IF (token_1 = "") THEN
X IF (vi$parse_next_ch (i, cmd, "!")) THEN
X RETURN (vi$do_subproc (cmd, i));
X ENDIF;
X ENDIF;
X
X IF (vi$leading_str (token_1, "copy")) THEN
X RETURN (vi$do_copy (cmd, i, whole_range, olen, start_line, end_line));
X ENDIF;
X
X IF (vi$leading_str (token_1, "move")) THEN
X RETURN (vi$do_move (cmd, i, whole_range, start_line, end_line));
X ENDIF;
X
X IF (vi$leading_str (token_1, "select")) AND (LENGTH (token_1) > 2) THEN
X RETURN (vi$do_select);
X ENDIF;
X
X IF (token_1 = "fill") THEN
X RETURN (vi$do_fill (cmd, i, whole_range, olen));
X ENDIF;
X
X IF ((LENGTH (token_1) > 1) AND (vi$leading_str (token_1, "upper") OR
X vi$leading_str (token_1, "lower") OR
X vi$leading_str (token_1, "invert"))) THEN
X RETURN (vi$do_case (token_1, whole_range));
X ENDIF;
X
X IF (token_1 = "s") THEN
X RETURN (vi$do_substitute (start_line, end_line, whole_range, i, cmd));
X ENDIF;
X
X IF (token_1 = "d") THEN
X RETURN (vi$do_delete (start_mark, whole_range, olen));
X ENDIF;
X
X ! Do the write file command. You can write either a buffer, or a
X ! portion of one.
X
X IF (vi$leading_str (token_1, "write")) THEN
X RETURN (vi$do_write (cmd, i, no_spec, token_1, whole_range));
X ENDIF;
X
X IF (token_1 = "wq") THEN
X RETURN (vi$do_wq (cmd, i, no_spec, token_1, whole_range));
X ENDIF;
X
X ! Read in a file to the current buffer.
X
X IF (vi$leading_str (token_1, "read")) THEN
X RETURN (vi$do_read (cmd, i, start_line, olen));
X ENDIF;
X
X IF (vi$leading_str (token_1, "file")) THEN
X RETURN (vi$do_file_ex (cmd, i));
X ENDIF;
X
X IF (vi$leading_str (token_1, "buffer")) THEN
X RETURN (vi$do_buffer (cmd, i, token_1));
X ENDIF;
X
X IF (token_1 = "so") THEN
X RETURN (vi$do_file (vi$rest_of_line (cmd, i), 1));
X ENDIF;
X
X IF (vi$leading_str (token_1, "messages")) THEN
X RETURN (vi$do_messages);
X ENDIF;
X
X IF (vi$leading_str (token_1, "delbuf")) THEN
X RETURN (vi$do_delbuf (cmd, i));
X ENDIF;
X
X IF (vi$leading_str (token_1, "xit")) THEN
X RETURN (vi$_ZZ);
X ENDIF;
X
X IF (token_1 = "rew") THEN
X RETURN (vi$_first_file);
X ENDIF;
X
X IF (vi$leading_str (token_1, "prev")) THEN
X RETURN (vi$_previous_file);
X ENDIF;
X
X IF (vi$leading_str (token_1, "next")) THEN
X RETURN (vi$_next_file);
X ENDIF;
X
X IF (token_1 = "tag") OR (token_1 = "ta") THEN
X vi$skip_white (cmd, i);
X IF (vi$rest_of_line (cmd, i) = "") THEN
X RETURN (vi$do_tag (0));
X ELSE
X RETURN (vi$do_tag (vi$rest_of_line (cmd, i)));
X ENDIF;
X ENDIF;
X
X IF (token_1 = "map") THEN
X RETURN (vi$map_keys (cmd, i));
X ENDIF;
X
X IF (token_1 = "unmap") THEN
X RETURN (vi$unmap_keys (cmd, i));
X ENDIF;
X
X IF (token_1 = "set") THEN
X RETURN (vi$set_commands (cmd, i));
X ENDIF;
X
X IF (token_1 = "tpu") THEN
X RETURN (vi$do_tpu (cmd, i, no_spec, whole_range));
X ENDIF;
X
X IF (token_1 = "cd") OR (token_1 = "chdir") THEN
X RETURN (vi$do_cd (cmd, i));
X ENDIF;
X
X ! Quit the current editor session.
X
X IF (vi$leading_str (token_1, "quit")) THEN
X RETURN (vi$do_quit (cmd, token_1));
X ENDIF;
X
X MESSAGE ("Unrecognized command!");
X RETURN (1);
XENDPROCEDURE;
X
X!
X!
X!
XPROCEDURE vi$do_unlearn (cmd, i)
X LOCAL
X keyn,
X com;
X
X MESSAGE ("Press the key you want to unlearn: ");
X keyn := vi$read_a_key;
X
X IF (keyn = F11) OR (ASCII (27) = ASCII (keyn)) THEN
X MESSAGE ("UNLEARN aborted!");
X RETURN (1);
X ENDIF;
X
X com := LOOKUP_KEY (keyn, COMMENT, vi$cmd_keys);
X IF (com <> "learn_sequence") THEN
X MESSAGE ("That key is not a learned KEY!");
X RETURN (1);
X ENDIF;
X
X UNDEFINE_KEY (keyn, vi$cmd_keys);
XENDPROCEDURE;
X
X!
X!
X!
XPROCEDURE vi$do_learn (cmd, i)
X LOCAL
X keyn,
X strg;
X
X MESSAGE ("Type KEY sequence, and press CTRL-R to remember sequence");
X vi$in_learn := 1;
X LEARN_BEGIN (EXACT);
X RETURN (1);
XENDPROCEDURE;
X
X!
X! Remember the keystrokes that have been typed.
X!
XPROCEDURE vi$remember
X
X LOCAL
X key,
X keyn,
X com;
X
X ON_ERROR
X RETURN (1);
X ENDON_ERROR;
X
X IF (vi$in_learn = 0) THEN
X RETURN (0);
X ENDIF;
X
X MESSAGE ("Press key to bind sequence to: ");
X keyn := vi$read_a_key;
X
X IF (keyn = F11) OR (ASCII (27) = ASCII (keyn)) THEN
X MESSAGE ("LEARN aborted!");
X com := LEARN_END;
X vi$in_learn := 0;
X RETURN (1);
X ENDIF;
X
X com := LOOKUP_KEY (keyn, COMMENT, vi$cmd_keys);
X IF (com = "active_macro") THEN
X MESSAGE ("That key is a mapped key, you must unmap it first");
X RETURN (1);
X ENDIF;
X
X key := "vi$ls_"+vi$key_map_name (keyn);
X EXECUTE (COMPILE (key+":=LEARN_END"));
X vi$in_learn := 0;
X DEFINE_KEY ("vi$play_back("+key+")", keyn, "learn_sequence", vi$cmd_keys);
X MESSAGE ("Sequence bound to key");
X RETURN (1);
XENDPROCEDURE;
X
X!
X!
X!
XPROCEDURE vi$play_back (prog)
X LOCAL
X old_play_back,
X old_global;
X
X IF (vi$m_level > 30) THEN
X MESSAGE ("Infinite loop detected in key macro sequence!");
X RETURN;
X ENDIF;
X vi$m_level := vi$m_level + 1;
X
X IF vi$undo_map THEN
X old_global := vi$in_global;
X vi$in_global := 0;
X IF (NOT old_global) THEN
X vi$save_for_undo (CURRENT_BUFFER, VI$LINE_MODE, 1);
X vi$in_global := 1;
X ENDIF;
X ENDIF;
X
X old_play_back := vi$playing_back;
X vi$playing_back := 1;
X EXECUTE (prog);
X vi$playing_back := old_play_back;
X vi$m_level := vi$m_level - 1;
X
X vi$in_global := old_global;
XENDPROCEDURE;
X
X!
X! Remove an abbreviation
X!
XPROCEDURE vi$do_unabbr (cmd, i)
X LOCAL
X separ,
X junk,
X idx,
X ch,
X abbr,
X abbrn;
X
X abbr := "";
X abbrn := "";
X
X junk := vi$skip_separ (cmd, i, " ", separ);
X IF (LENGTH (junk) = 0) THEN
X MESSAGE ("Abbreviation name required!");
X RETURN (1);
X ENDIF;
X
X idx := 1;
X LOOP
X EXITIF idx > LENGTH (junk);
X ch := SUBSTR (junk, idx, 1);
X IF (INDEX (vi$_alpha_chars, ch) = 0) THEN
X MESSAGE ("Invalid character in UNABBR name, '"+ch+
X "', is not valid.");
X RETURN (1);
X ENDIF;
X IF (INDEX (vi$_upper_chars, ch) <> 0) THEN
X abbrn := abbrn + "_";
X ENDIF;
X abbrn := abbrn + ch;
X idx := idx + 1;
X ENDLOOP;
X EXECUTE (COMPILE ("VI$ABBR_"+abbrn+":=0;"));
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Create an abbreviation
X!
XPROCEDURE vi$do_abbr (cmd, i)
X LOCAL
X separ,
X abbr,
X junk,
X idx,
X ch,
X abbrn;
X
X abbr := "";
X abbrn := "";
X
X junk := vi$skip_separ (cmd, i, " ", separ);
X IF (LENGTH (junk) = 0) THEN
X vi$show_abbrevs;
X RETURN (0);
X ENDIF;
X
X idx := 1;
X LOOP
X EXITIF idx > LENGTH (junk);
X ch := SUBSTR (junk, idx, 1);
X IF (INDEX (vi$_alpha_chars, ch) = 0) THEN
V MESSAGE ("Invalid character in ABBR name, '"+ch+"', is not valid."
X);
X RETURN (1);
X ENDIF;
X IF (INDEX (vi$_upper_chars+"_", ch) <> 0) THEN
X abbrn := abbrn + "_";
X ENDIF;
X abbrn := abbrn + ch;
X idx := idx + 1;
X ENDLOOP;
X abbr := vi$rest_of_line (cmd, i);
X EXECUTE (COMPILE ("VI$ABBR_"+abbrn+":="""+abbr+""""));
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Execute the contents of the buffers named following an '@'.
X!
XPROCEDURE vi$do_macro_buffer (cmd, i)
X LOCAL
X line,
X mode,
X buf_name,
X pos,
X buf,
X ch;
X
X ON_ERROR
X ENDON_ERROR;
X
X vi$skip_white (cmd, i);
X
X LOOP
X ch := vi$next_char (cmd, i);
X EXITIF (ch = "");
X
X IF (INDEX ("123456789", ch) <> 0) THEN
X
X ! Selected a deletion buffer.
X
X buf_name := "vi$del_buf_" + ch;
X ELSE
X IF (INDEX (vi$_letter_chars, ch) <> 0) THEN
X
X ! Selected a named buffer.
X
X CHANGE_CASE (ch, LOWER);
X
X buf_name := "vi$ins_buf_" + ch;
X ELSE
X vi$message ("Invalid buffer!");
X RETURN;
X ENDIF;
X ENDIF;
X
X vi$global_var := 0;
X EXECUTE (COMPILE ("vi$global_var := "+buf_name+";"));
X buf := vi$global_var;
X IF (buf = 0) THEN
X vi$message ("There is no text in that buffer!");
X RETURN;
X ENDIF;
X
X pos := MARK (NONE);
X POSITION (BEGINNING_OF (buf));
X
X ! Skip the buffer mode indicator.
X
X mode := INT (vi$current_line);
X MOVE_VERTICAL (1);
X line := vi$current_line;
X
X IF mode = VI$LINE_MODE THEN
X line := line + ASCII (13);
X ENDIF;
X
X POSITION (pos);
X vi$do_macro (line, 1);
X ENDLOOP;
X
XENDPROCEDURE;
X
X!
X!
X!
XPROCEDURE vi$do_global (cmd, i)
X LOCAL
X cmd_str,
X sch_str,
X subs_str,
X sch,
X ch,
X nsubs,
X lpos,
X olen,
X fpos;
X
X olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
X vi$skip_white (cmd, i);
X IF NOT vi$parse_next_ch (i, cmd, "/") THEN
X MESSAGE ("/ Search string must follow global!");
X RETURN (1);
X ENDIF;
X
X sch := SUBSTR (cmd, i-1, 1);
X sch_str := "";
X LOOP
X EXITIF (vi$parse_next_ch (i, cmd, sch));
X EXITIF (LENGTH (cmd) < i);
X ch := SUBSTR (cmd, i, 1);
X IF (ch = "\") THEN
X sch_str := sch_str + SUBSTR (cmd, i, 2);
X i := i + 1;
X ELSE
X sch_str := sch_str + ch;
X ENDIF;
X i := i + 1;
X ENDLOOP;
X
X IF (LENGTH (cmd) < i) THEN
X MESSAGE ("Incomplete command!");
X RETURN (1);
X ENDIF;
X
X vi$save_for_undo (CURRENT_BUFFER, VI$LINE_MODE, 1);
X cmd_str := vi$rest_of_line (cmd, i);
X
X SET (FORWARD, CURRENT_BUFFER);
X POSITION (BEGINNING_OF (CURRENT_BUFFER));
X
X nsubs := 0;
X subs_str := SUBSTR (cmd_str, 2, 255);
X
X LOOP
X fpos := vi$find_str (sch_str, 1);
X EXITIF fpos = 0;
X
X POSITION (fpos);
X IF cmd_str = "d" THEN
X ERASE_LINE;
X ELSE
X IF SUBSTR (cmd_str, 1, 1) = "s" THEN
X lpos := vi$global_subs (subs_str, nsubs);
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X MOVE_VERTICAL (1);
X ELSE
X MESSAGE ("Bad command for global: "+cmd_str);
X vi$kill_undo;
X vi$undo_end := 0;
$ GoSub Convert_File
$ Exit