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:42:34.03
$!
$! It contains the following 1 file:
$! VI.5
$!=============================================================================
$ 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.5"
$ Check_Sum_is=1761978794
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X ENDIF;
X RETURN;
X ENDIF;
X
X IF (key = TAB_KEY) THEN
X key := ASCII (9);
X ELSE
X IF (key = RET_KEY) THEN
X key := ASCII (13);
X ELSE
X IF (key = DEL_KEY) THEN
X key := ASCII (8);
X ELSE
X key := ASCII (key);
X ENDIF;
X ENDIF;
X ENDIF;
X
X IF ((CURRENT_OFFSET + act_cnt) <= LENGTH (vi$current_line)) THEN
X IF (key = ASCII (13)) THEN
X MOVE_HORIZONTAL (act_cnt);
X ELSE
X MOVE_HORIZONTAL (act_cnt - 1);
X ENDIF;
X vi$save_for_undo (CREATE_RANGE (pos, MARK(NONE), NONE),
X VI$IN_LINE_MODE, 1);
X IF (key = ASCII (13)) THEN
X MOVE_HORIZONTAL (-act_cnt);
X ELSE
X MOVE_HORIZONTAL (-(act_cnt-1));
X ENDIF;
X IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
X MOVE_HORIZONTAL (-1);
X vi$undo_start := MARK (NONE);
X MOVE_HORIZONTAL (1);
X ELSE
X vi$undo_start := 0;
X ENDIF;
X
X SET (OVERSTRIKE, CURRENT_BUFFER);
X LOOP
X IF (key = ASCII (13)) THEN
X SPLIT_LINE;
X ERASE_CHARACTER (1);
X ELSE
X COPY_TEXT (key);
X ENDIF;
X act_cnt := act_cnt - 1;
X EXITIF act_cnt = 0;
X ENDLOOP;
X
X IF (key = ASCII (13)) THEN
X MOVE_HORIZONTAL (1);
X ENDIF;
X
X MOVE_HORIZONTAL (-1);
X vi$undo_end := MARK (NONE);
X
X SET (INSERT, CURRENT_BUFFER);
X IF (vi$undo_start = 0) THEN
X vi$undo_start := BEGINNING_OF (CURRENT_BUFFER);
X ELSE
X pos := MARK (NONE);
X POSITION (vi$undo_start);
X MOVE_HORIZONTAL (1);
X vi$undo_start := MARK (NONE);
X POSITION (pos);
X ENDIF;
X ELSE
X POSITION (pos);
X ENDIF;
X
X IF (vi$show_mode) THEN
X MESSAGE ("");
X ENDIF;
X RETURN;
XENDPROCEDURE
X
X!
X! Perform the 'R' command
X!
XPROCEDURE vi$_replace_str
X
X LOCAL
X replace,
X max_mark,
X start_pos,
X spos,
X pos,
X max_col;
X
X pos := MARK (NONE);
X max_col := CURRENT_OFFSET;
X start_pos := max_col;
X MOVE_HORIZONTAL (LENGTH (CURRENT_LINE) - CURRENT_OFFSET);
X max_mark := MARK(NONE);
X vi$undo_end := MARK (NONE);
X POSITION (pos);
X vi$update (CURRENT_WINDOW);
X replace := CURRENT_LINE;
X spos := vi$get_undo_start;
X vi$save_for_undo (CREATE_RANGE (pos, max_mark, NONE), VI$IN_LINE_MODE, 1);
X
X vi$line_edit (max_col, start_pos, max_mark, replace);
X pos := MARK (NONE);
X vi$undo_start := vi$set_undo_start (spos);
X POSITION (pos);
XENDPROCEDURE;
X
X!
X! As in REAL vi, this procedure does not recognize a repeat count.
X! A simple loop would make it possible to use the repeat count contained
X! in "vi$active_count". A macro is used so that all of the crap for undo
X! need not be placed here.
X!
XPROCEDURE vi$_change_case
X LOCAL
X pos;
X
X vi$active_count := 0;
X pos := INDEX (vi$_lower_chars, CURRENT_CHARACTER);
X IF pos <> 0 THEN
X vi$do_macro ("r"+SUBSTR (vi$_upper_chars, pos, 1)+"l", 0);
X ELSE
X pos := INDEX (vi$_upper_chars, CURRENT_CHARACTER);
X IF pos <> 0 THEN
X vi$do_macro ("r"+SUBSTR (vi$_lower_chars, pos, 1)+"l", 0);
X ELSE
X vi$kill_undo;
X vi$undo_end := 0;
X MOVE_HORIZONTAL (1);
X ENDIF;
X ENDIF;
X
XENDPROCEDURE;
X
X!
X!
X!
XPROCEDURE vi$init_action (olen)
X LOCAL
X nchar;
X
X olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
X
X IF (vi$select_pos = 0) THEN
X nchar := vi$read_a_key;
X IF (INDEX ("123456789", ASCII(nchar)) <> 0) THEN
X vi$active_count := INDEX (vi$_numeric_chars, ASCII(nchar)) - 1;
X LOOP
X nchar := vi$read_a_key;
X EXITIF (INDEX (vi$_numeric_chars, ASCII(nchar)) = 0);
X vi$active_count := vi$active_count *
X 10 + (INDEX (vi$_numeric_chars, ASCII (nchar)) - 1);
X ENDLOOP;
X ENDIF;
X ELSE
X nchar := KEY_NAME (".");
X ENDIF;
X RETURN (nchar);
XENDPROCEDURE;
X
X!
X!
X!
XPROCEDURE vi$get_prog (nchar)
X IF (vi$select_pos = 0) THEN
X RETURN (LOOKUP_KEY (KEY_NAME (nchar), COMMENT, vi$move_keys));
X ELSE
X RETURN ("vi$get_select_pos");
X ENDIF;
XENDPROCEDURE;
X
X!
X!
X!
XPROCEDURE vi$do_movement (prog, mtype)
X
X vi$endpos := 0;
X vi$new_endpos := 0;
X vi$command_type := mtype;
X
X EXECUTE (COMPILE ("vi$endpos := " + prog));
X IF vi$new_endpos <> 0 THEN
X vi$endpos := vi$new_endpos;
X ENDIF;
XENDPROCEDURE;
X
X!
X! Perform the operations associated with the 'c' command.
X!
XPROCEDURE vi$_change
X
X LOCAL
X max_mark,
X max_col,
X start_col,
X start_offset,
X end_offset,
X start_line,
X end_line,
X cha_range,
X pos,
X olen,
X prog,
X do_back,
X nchar;
X
X ON_ERROR;
X vi$message ("Error occured during change, at line: "+STR(ERROR_LINE));
X POSITION (vi$start_pos);
X RETURN;
X ENDON_ERROR;
X
X vi$new_offset := 1;
X nchar := vi$init_action (olen);
X
X IF (nchar = KEY_NAME ('c')) THEN
X vi$_big_s;
X RETURN;
X ENDIF;
X
X ! If the movement will be backwards, then the region must not include
X ! the current character.
X
X do_back := vi$get_direction (nchar);
X
X IF do_back THEN
X vi$move_horizontal (-1);
X vi$start_pos := MARK (NONE);
X vi$move_horizontal (1);
X ELSE
X vi$start_pos := MARK (NONE);
X ENDIF;
X
X prog := vi$get_prog (nchar);
X
X IF prog <> "" THEN
X vi$do_movement (prog, VI$CHANGE_TYPE);
X
X POSITION (vi$start_pos);
X start_offset := CURRENT_OFFSET;
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X start_line := MARK (NONE);
X POSITION (vi$start_pos);
X
X IF (vi$endpos <> 0) THEN
X POSITION (vi$endpos);
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X end_line := MARK (NONE);
X POSITION (vi$endpos);
X
X IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
X (NOT do_back) AND
X (INDEX (vi$weird_moves, ASCII (nchar)) = 0) THEN
X vi$move_horizontal (-1);
X ENDIF;
X end_offset := CURRENT_OFFSET + 1;
X
X cha_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
X
X IF (start_line <> end_line) THEN
X IF (cha_range <> 0) THEN
X POSITION (vi$start_pos);
X
X vi$undo_start := vi$get_undo_start;
X
X vi$save_for_undo (cha_range, vi$yank_mode, 0);
X ERASE (cha_range);
X
X IF (vi$while_not_esc = 0) THEN
X vi$undo_end := 0;
X ELSE
X vi$undo_end := MARK (NONE);
X vi$undo_start := vi$set_undo_start (vi$undo_start);
X POSITION (vi$undo_end);
X ENDIF;
X ELSE
X vi$message ("Internal error while changing!");
X ENDIF;
X ELSE
X IF (cha_range <> 0) THEN
X IF (start_offset < end_offset) THEN
X max_col := end_offset;
X MOVE_HORIZONTAL (1);
X max_mark := MARK (NONE);
X MOVE_HORIZONTAL (-1);
X start_col := start_offset;
X ELSE
X POSITION (vi$start_pos);
X MOVE_HORIZONTAL (1);
X max_col := CURRENT_OFFSET;
X max_mark := MARK (NONE);
X POSITION (vi$start_pos);
X start_col := end_offset - 1;
X ENDIF;
X
X vi$save_for_undo (SUBSTR (vi$current_line, start_col + 1,
X max_col - start_col), vi$yank_mode, 0);
X
X SET (OVERSTRIKE, CURRENT_BUFFER);
X COPY_TEXT ("$");
X SET (INSERT, CURRENT_BUFFER);
X
X IF (start_offset < end_offset) THEN
X POSITION (vi$start_pos);
X ELSE
X POSITION (vi$endpos);
X ENDIF;
X
X vi$update (CURRENT_WINDOW);
X
X vi$undo_start := vi$get_undo_start;
X
V if (vi$line_edit (max_col, start_col, max_mark, 0) = 0) TH
XEN
X vi$undo_end := 0;
X IF (start_col <> 0) THEN
X MOVE_HORIZONTAL (1);
X ENDIF;
X ELSE
X IF (CURRENT_OFFSET = 0) THEN
X MOVE_HORIZONTAL (-1);
X vi$undo_end := MARK (NONE);
X MOVE_HORIZONTAL (1);
X ELSE
X vi$undo_end := MARK (NONE);
X ENDIF;
X ENDIF;
X
X pos := MARK (NONE);
X
X vi$undo_start := vi$set_undo_start (vi$undo_start);
X POSITION (pos);
X ELSE
X vi$message ("Internal error while changing!");
X ENDIF;
X ENDIF;
X ELSE
X vi$abort (0);
X ENDIF;
X ELSE
X vi$abort (0);
X ENDIF;
X
X vi$check_length (olen);
XENDPROCEDURE;
X
X!
X! Decide which direction the movement will be based on whether or not
X! the last movement was a t, T, f, F, or other backward movement.
X!
XPROCEDURE vi$get_direction (nchar)
X LOCAL
X do_back;
X
X do_back := 0;
X
X IF ((ASCII (nchar) = ",") AND ((vi$last_s_func = "vi$find_char") OR
X (vi$last_s_func = "vi$to_char"))) OR
X ((ASCII (nchar) = ";") AND ((vi$last_s_func = "vi$back_find_char") OR
V (vi$last_s_func = "vi$back_to_char"))) THE
XN
X do_back := 1;
X ENDIF;
X
X IF (INDEX (vi$back_moves + vi$weird2_moves, ASCII(nchar)) <> 0) THEN
X do_back := 1;
X ENDIF;
X
X RETURN (do_back);
XENDPROCEDURE;
X
X!
X! Given the fact that a select range is active, modify vi$start_pos
X! to be the start of that range, and return the end of the select
X! range.
X!
XPROCEDURE vi$get_select_pos
X LOCAL
X pos,
X rng;
X
X rng := SELECT_RANGE;
X IF (rng <> 0) THEN
X pos := MARK (NONE);
X vi$select_pos := 0;
X vi$start_pos := BEGINNING_OF (rng);
X POSITION (END_OF (rng));
X MOVE_HORIZONTAL (1);
X RETURN (vi$retpos (pos));
X ELSE
X vi$select_pos := 0;
X vi$message ("No region selected!");
X ENDIF;
X RETURN (0);
XENDPROCEDURE;
X
X!
X! Perform the operations associated with the 'S' command.
X!
XPROCEDURE vi$_big_s
X LOCAL
X max_mark,
X start_pos,
X max_col,
X rng,
X start,
X end,
X pos;
X
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X MOVE_HORIZONTAL (-1);
X vi$undo_start := MARK (NONE);
X MOVE_HORIZONTAL (1);
X
X IF (MARK (NONE) = BEGINNING_OF (CURRENT_BUFFER)) THEN
X vi$undo_end := 0;
X ENDIF;
X
X start := MARK (NONE);
X IF (LENGTH (vi$current_line) > 0) THEN
X MOVE_VERTICAL (vi$cur_active_count - 1);
X MOVE_HORIZONTAL (LENGTH (vi$current_line) - 1);
X ENDIF;
X
X end := MARK (NONE);
X rng := CREATE_RANGE (start, end, NONE);
X POSITION (start);
X vi$save_for_undo (rng, VI$IN_LINE_MODE, 1);
X
X ERASE (rng);
X
X max_col := CURRENT_OFFSET;
X start_pos := max_col;
X max_mark := MARK(NONE);
X
X vi$update (CURRENT_WINDOW);
X
X IF (vi$line_edit (max_col, start_pos, max_mark, 0) <> 0) THEN
X vi$undo_end := MARK (NONE);
X ELSE
X vi$undo_end := 0;
X ENDIF;
X pos := MARK (NONE);
X vi$undo_start := vi$set_undo_start (vi$undo_start);
X POSITION (pos);
XENDPROCEDURE;
X
X!
X! This function performs the operations associated with the '"' command
X! that allows one of the 26 named buffers, or one of the 10 delete
X! buffers to be the target of a 'd', 'D', 'x', 'X', 'y', 'Y', 'p' or 'P'
X! command.
X!
XPROCEDURE vi$select_buffer
X LOCAL
X numeric,
X asc_action,
X action,
X prog,
X buf_name,
X nchar;
X
X ON_ERROR;
X RETURN;
X ENDON_ERROR;
X
X nchar := vi$read_a_key;
X action := vi$read_a_key;
X asc_action := ASCII (action);
X numeric := (INDEX (vi$_numeric_chars, asc_action) <> 0);
X
X IF numeric THEN
X vi$active_count := INDEX (vi$_numeric_chars, asc_action) - 1;
X LOOP
X action := vi$read_a_key;
X asc_action := ASCII (action);
X EXITIF (INDEX (vi$_numeric_chars, asc_action) = 0);
X vi$active_count := (vi$active_count * 10) +
V (INDEX (vi$_numeric_chars, asc_action) - 1
X);
X ENDLOOP;
X ENDIF;
X
V IF (asc_action <> 'P') AND (asc_action <> 'p') AND (asc_action <> 'd') AN
XD
V (asc_action <> 'D') AND (asc_action <> 'y') AND (asc_action <> 'Y') AN
XD
X (asc_action <> 'x') AND (asc_action <> 'X') AND (NOT numeric) THEN
X
X vi$message ("Unrecognized buffer action, ignoring: '"+asc_action+"'");
X
X RETURN;
X ENDIF;
X
X IF (INDEX ("123456789", ASCII(nchar)) <> 0) THEN
X
X IF (asc_action <> 'P') AND (asc_action <> 'p') THEN
X RETURN;
X ENDIF;
X
X ! Selected a deletion buffer.
X
X buf_name := "vi$del_buf_"+ASCII(nchar);
X
X ELSE
X IF (INDEX (vi$_letter_chars, ASCII(nchar)) <> 0) THEN
X
X ! Selected a named buffer.
X
X IF (INDEX (vi$_upper_chars, ASCII(nchar)) <> 0) THEN
X nchar := SUBSTR (vi$_lower_chars,
X INDEX (vi$_upper_chars, ASCII(nchar)), 1);
X ENDIF;
X
X buf_name := "vi$ins_buf_"+ASCII(nchar);
X
X ! Only create a buffer if we are going to put something into it.
X
X IF (asc_action <> 'P') AND (asc_action <> 'p') THEN
X EXECUTE (COMPILE ('vi$get_ins_buf(' +
X buf_name + ', "'+buf_name+'");'));
X ELSE
X vi$global_var := 0;
X EXECUTE (COMPILE ("vi$global_var:="+buf_name));
X IF (vi$global_var = 0) THEN
X MESSAGE ("There is nothing in that buffer!");
X RETURN;
X ENDIF;
X ENDIF;
X ELSE
X vi$message ("Invalid buffer!");
X RETURN;
X ENDIF;
X ENDIF;
X
X ! We now have a buffer, and the next command key, so envoke the
X ! proper code.
X
X vi$do_buf_act (asc_action, 'P', "vi$put_here (VI$HERE, "+buf_name+");");
X vi$do_buf_act (asc_action, 'p', "vi$put_after ("+buf_name+");");
X vi$do_buf_act (asc_action, 'd', "vi$_delete (0, "+buf_name+");");
X vi$do_buf_act (asc_action, 'D',
X "vi$_delete (KEY_NAME('$'), "+buf_name+");");
X vi$do_buf_act (asc_action, 'x', "vi$_delete ('l', "+buf_name+");");
X vi$do_buf_act (asc_action, 'X', "vi$_delete ('h', "+buf_name+");");
X vi$do_buf_act (asc_action, 'y', "vi$_yank (0, "+buf_name+");");
X vi$do_buf_act (asc_action, 'Y', "vi$_yank ('y', "+buf_name+");");
V vi$do_buf_act (asc_action, 'Y', "vi$_yank (KEY_NAME('y'), "+buf_name+");"
X);
XENDPROCEDURE;
X
X!
X! Perform action based on key typed and passed data
X!
XPROCEDURE vi$do_buf_act (act_type, look_for, what_to_do)
X
X IF (act_type = look_for) THEN
X EXECUTE (COMPILE (what_to_do));
X ENDIF;
XENDPROCEDURE;
X
X!
X! Create a buffer named 'bname' providing that there is not already a
X! buffer by that name.
X!
XPROCEDURE vi$get_ins_buf (buf, bname)
X
X IF (buf = 0) THEN
X buf := vi$init_buffer (bname, "");
X ENDIF;
X
X IF buf = 0 THEN
X vi$message ("Error creating named buffer!");
X ENDIF;
XENDPROCEDURE;
X
X!
X! Perform the delete command tied to the 'd' key.
X!
XPROCEDURE vi$_delete (opchar, dest_buf)
X
X LOCAL
X olen,
X old_offset,
X new_offset,
X era_range,
X opos,
X prog,
X do_back,
X nchar;
X
X ON_ERROR;
X vi$message ("Error occured during delete, at line: "+STR(ERROR_LINE));
X POSITION (vi$start_pos);
X RETURN;
X ENDON_ERROR;
X
X vi$new_offset := 1;
X nchar := opchar;
X
X opos := MARK (NONE);
X IF (nchar = 0) THEN
X nchar := vi$init_action (olen);
X ELSE
X olen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
X ENDIF;
X
X ! If the movement will be backwards, then the region must not include
X ! the current character.
X
X old_offset := -1;
X new_offset := -1;
X
X do_back := vi$get_direction (nchar);
X
X IF do_back THEN
X old_offset := CURRENT_OFFSET;
X vi$move_horizontal (-1);
X new_offset := CURRENT_OFFSET;
X ENDIF;
X
X vi$start_pos := MARK (NONE);
X
X ! For "dh" or "X" (a macro of "dh"), we must let vi$left do the movement.
X
X IF (INDEX (vi$weird2_moves, ASCII(nchar)) <> 0) AND
V (old_offset <> new_offset) THE
XN
X MOVE_HORIZONTAL (1);
X ENDIF;
X
X prog := vi$get_prog (nchar);
X
X IF prog <> "" THEN
X vi$do_movement (prog, VI$DELETE_TYPE);
X
X IF (vi$endpos <> 0) THEN
X POSITION (vi$endpos);
X
X IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
X (NOT do_back) AND
X (INDEX (vi$weird_moves, ASCII (nchar)) = 0) THEN
X MOVE_HORIZONTAL (-1);
X ENDIF;
X
X era_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
X
X IF (era_range <> 0) THEN
X IF (GET_INFO (dest_buf, "TYPE") = INTEGER) THEN
X vi$cur_text := vi$put2del_buf (vi$yank_mode, era_range);
X ELSE
X vi$type2buf (STR (vi$yank_mode), dest_buf);
X vi$cur_text := vi$cp2buf (era_range, dest_buf);
X ENDIF;
X
X vi$undo_end := 0;
X vi$undo_start := vi$start_pos;
X POSITION (BEGINNING_OF (era_range));
X vi$save_for_undo (era_range, vi$yank_mode, 1);
X ERASE (era_range);
X ELSE
X vi$message ("Internal error while deleting!");
X ENDIF;
X POSITION (vi$start_pos);
X ELSE
X vi$abort (0);
X POSITION (opos);
X ENDIF;
X ELSE
X POSITION (opos);
X vi$abort (0);
X ENDIF;
X
X vi$check_length (olen);
XENDPROCEDURE;
X
X!
X! This procedure checks a change in the size of the buffer, and reports
X! the change if it is greater than the number set with ":set report"
X!
XPROCEDURE vi$check_length (olen)
X LOCAL
X nlen;
X
X nlen := GET_INFO (CURRENT_BUFFER, "RECORD_COUNT");
X
X IF (nlen - vi$report) >= olen THEN
X vi$message (STR (nlen - olen) + " more lines!");
X ELSE
X IF (nlen + vi$report <= olen) THEN
X vi$message (STR (olen - nlen) + " fewer lines!");
X ENDIF;
X ENDIF;
XENDPROCEDURE;
X
X!
X! Perform the yank command tied to the 'y' key.
X!
XPROCEDURE vi$_yank (opchar, dest_buf)
X
X LOCAL
X old_offset,
X new_offset,
X pos,
X oline,
X nline,
X yank_range,
X prog,
X do_back,
X nchar;
X
X ON_ERROR;
X vi$message ("Error occured during yank, at line: "+STR(ERROR_LINE));
X POSITION (vi$start_pos);
X RETURN;
X ENDON_ERROR;
X
X nchar := opchar;
X pos := MARK (NONE);
X
X IF nchar = 0 THEN
X nchar := vi$init_action (oline);
X ENDIF;
X
X old_offset := -1;
X new_offset := -1;
X
X ! If the movement will be backwards, then the region must not include
X ! the current character.
X
X do_back := vi$get_direction (nchar);
X
X IF do_back THEN
X old_offset := CURRENT_OFFSET;
X vi$move_horizontal (-1);
X new_offset := CURRENT_OFFSET;
X ENDIF;
X
X vi$start_pos := MARK (NONE);
X
X ! For "yl" and similar moves, we must let vi$left to the movement.
X
X IF (INDEX (vi$weird2_moves, ASCII(nchar)) <> 0) AND
V (old_offset <> new_offset) THE
XN
X MOVE_HORIZONTAL (1);
X ENDIF;
X
X prog := vi$get_prog (nchar);
X
X IF prog <> "" THEN
X vi$do_movement (prog, VI$YANK_TYPE);
X
X oline := vi$cur_line_no;
X IF (vi$endpos <> 0) THEN
X POSITION (vi$endpos);
X nline := vi$abs (vi$cur_line_no - oline);
X IF (nline >= vi$report) THEN
X vi$message (STR (nline) + " lines yanked");
X ENDIF;
X IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) AND
X (NOT do_back) AND
X (INDEX (vi$weird_moves, ASCII (nchar)) = 0) THEN
X MOVE_HORIZONTAL (-1);
X ENDIF;
X
X yank_range := CREATE_RANGE (vi$start_pos, MARK (NONE), NONE);
X
X IF (yank_range <> 0) THEN
X IF (GET_INFO (dest_buf, "TYPE") = INTEGER) THEN
X vi$cur_text := vi$put2yank_buf (yank_range, vi$temp_buf);
X ELSE
X vi$cur_text := vi$put2yank_buf (yank_range, dest_buf);
X ENDIF;
X ELSE
X vi$message ("Internal error while yanking!");
X ENDIF;
X ELSE
X vi$abort (0);
X ENDIF;
X
X POSITION (pos);
X ELSE
X vi$abort (0);
X ENDIF;
X
XENDPROCEDURE;
X
X!
X! Return the absolute value of the value passed.
X!
XPROCEDURE vi$abs (val)
X IF val < 0 THEN
X RETURN (-val);
X ENDIF;
X RETURN (val);
XENDPROCEDURE;
X
X!
X! Given a range of a buffer, or a string, place it into the "kill-ring"
X! sliding the text back one slot that is already there.
X!
XPROCEDURE vi$put2del_buf (mode, string_parm)
X
X LOCAL
X local_str,
X pos;
X
X pos := MARK (NONE);
X
X IF (mode = VI$LINE_MODE) THEN
X
X ! Slide each range back one slot, throwing away the last.
X
X vi$mv2buf (vi$del_buf_8, vi$del_buf_9);
X vi$mv2buf (vi$del_buf_7, vi$del_buf_8);
X vi$mv2buf (vi$del_buf_6, vi$del_buf_7);
X vi$mv2buf (vi$del_buf_5, vi$del_buf_6);
X vi$mv2buf (vi$del_buf_4, vi$del_buf_5);
X vi$mv2buf (vi$del_buf_3, vi$del_buf_4);
X vi$mv2buf (vi$del_buf_2, vi$del_buf_3);
X vi$mv2buf (vi$del_buf_1, vi$del_buf_2);
X
X ! Place the new text at the front.
X
X vi$type2buf (STR(mode), vi$del_buf_1);
X vi$cp2buf (string_parm, vi$del_buf_1);
X ENDIF;
X
X ! Save the text so that a normal 'p' or 'P' command also works.
X
X vi$type2buf (STR(mode), vi$temp_buf);
X vi$cp2buf (string_parm, vi$temp_buf);
X
X POSITION (pos);
X RETURN (vi$temp_buf);
XENDPROCEDURE;
X
X!
X! Copy the text specified by source into the delete buffer given by
X! dest. If dest is zero, the it will be set to the value of a newly
X! created buffer.
X!
XPROCEDURE vi$cp2buf (source, dest)
X LOCAL
X pos;
X
X pos := MARK (NONE);
X
X IF (source <> 0) THEN
X IF (dest = 0) THEN
X dest := vi$init_buffer ("TEMP_BUF_"+str(vi$temp_buf_num), "");
X vi$temp_buf_num := vi$temp_buf_num + 1;
X ENDIF;
X
X POSITION (dest);
X COPY_TEXT (source);
X ENDIF;
X
X POSITION (pos);
XENDPROCEDURE;
X
X!
X! vi$mv2buf is like vi$cp2buf except that vi$mv2buf erases the buffer before
X! performing the copy.
X!
XPROCEDURE vi$mv2buf (source, dest)
X LOCAL
X pos;
X
X pos := MARK (NONE);
X
X IF (source <> 0) THEN
X IF (dest = 0) THEN
X dest := vi$init_buffer ("TEMP_BUF_"+str(vi$temp_buf_num), "");
X vi$temp_buf_num := vi$temp_buf_num + 1;
X ELSE
X ERASE (dest);
X ENDIF;
X
X POSITION (dest);
X COPY_TEXT (source);
X ENDIF;
X
X POSITION (pos);
XENDPROCEDURE;
X
X!
X! Given the string representation of either VI$LINE_MODE or VI$IN_LINE_MODE,
X! place that text into the buffer given by dest.
X!
XPROCEDURE vi$type2buf (source, dest)
X LOCAL
X pos;
X
X pos := MARK (NONE);
X
X IF (source <> 0) THEN
X IF (dest = 0) THEN
X dest := vi$init_buffer ("TEMP_BUF_"+str(vi$temp_buf_num), "");
X vi$temp_buf_num := vi$temp_buf_num + 1;
X ELSE
X ERASE (dest);
X ENDIF;
X
X POSITION (BEGINNING_OF (dest));
X COPY_TEXT (source);
X SPLIT_LINE;
X ENDIF;
X
X POSITION (pos);
XENDPROCEDURE;
X
X!
X! Save a piece of yanked text including the mode that it was yanked.
X!
XPROCEDURE vi$put2yank_buf (string_parm, dest_buf)
X
X LOCAL
X pos;
X
X pos := MARK (NONE);
X
X ! Set type of text in buffer.
X
X vi$type2buf (STR (vi$yank_mode), dest_buf);
X vi$cp2buf (string_parm, dest_buf);
X POSITION (pos);
X
X RETURN (dest_buf);
XENDPROCEDURE;
X
X!
X! This is a debugging procedure used to view the contents of a buffer.
X! It displays the buffer indicated by 'buf', and sets the status line
X! of the window displayed to contain the text given by 'stat_line'.
X!
XPROCEDURE vi$show_buf (buf, stat_line)
X LOCAL
X this_key,
X pos,
X new_win;
X
X IF (GET_INFO (buf, "TYPE") <> BUFFER) THEN
X vi$message ("show_buf called with non_buffer, message: "+stat_line);
X RETURN;
X ENDIF;
X
X pos := MARK (NONE);
X new_win := CREATE_WINDOW (1, 23, ON);
X MAP (new_win, buf);
X POSITION (buf);
X SET (STATUS_LINE, new_win, REVERSE, stat_line +
X ", BUFFER NAME: '"+GET_INFO (buf, "NAME")+"'");
X vi$pos_in_middle (MARK (NONE));
X UPDATE (new_win);
X LOOP
X vi$message ("Press RETURN to continue editing...");
X this_key := READ_KEY;
X EXITIF (this_key = RET_KEY);
X
X IF (this_key = CTRL_D_KEY) OR
X (this_key = CTRL_U_KEY) OR
X (this_key = CTRL_F_KEY) OR
X (this_key = CTRL_B_KEY) OR
X (this_key = KEY_NAME ('h')) OR
X (this_key = KEY_NAME ('j')) OR
X (this_key = KEY_NAME ('k')) OR
X (this_key = KEY_NAME ('l')) THEN
X
X EXECUTE (LOOKUP_KEY (this_key, PROGRAM, vi$cmd_keys));
X UPDATE (new_win);
X ENDIF;
X ENDLOOP;
X
X UNMAP (new_win);
X DELETE (new_win);
X POSITION (pos);
X UPDATE (CURRENT_WINDOW);
XENDPROCEDURE;
X
X!
X! This procedure moves the cursor down the number of lines indicated by
X! vi$active count. The parameter passed is used by delete and yank
X! operations to differentiate them from normal cursor movement.
X!
XPROCEDURE vi$downline (adj)
X
X LOCAL
X pos,
X tabstops,
X cur_off,
X offset;
X
X ! Ignore error messages
X
X ON_ERROR
X vi$active_count := 0;
X POSITION (pos);
X RETURN (0);
X ENDON_ERROR;
X
X pos := MARK (NONE);
X
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X vi$start_pos := MARK (NONE);
X
X POSITION (pos);
X
X tabstops := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");
X
X IF (GET_INFO (tabstops, "TYPE") <> STRING) THEN
X offset := CURRENT_OFFSET;
X cur_off := GET_INFO (SCREEN, "CURRENT_COLUMN") - 1;
X MOVE_VERTICAL (vi$cur_active_count + adj);
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X IF (vi$new_offset = 1) THEN
X vi$max_offset := cur_off;
X vi$new_offset := 0;
X ELSE
X IF (cur_off < vi$max_offset) THEN
X cur_off := vi$max_offset;
X ENDIF;
X ENDIF;
X
X ! Save the beginning of the line as the new beginning.
X
X vi$new_endpos := MARK (NONE);
X vi$to_offset (CURRENT_LINE, cur_off, tabstops);
X ELSE
X MOVE_VERTICAL (vi$cur_active_count + adj);
X ENDIF;
X
X vi$yank_mode := VI$LINE_MODE;
X RETURN (vi$retpos (pos));
XENDPROCEDURE;
X
X!
X! Move left one location. Do not wrap at edge of the screen.
X!
XPROCEDURE vi$left
X
X LOCAL
X pos;
X
X ! Ignore error messages
X
X ON_ERROR
X vi$active_count := 0;
X POSITION (pos);
X RETURN (0);
X ENDON_ERROR;
X
X pos := MARK (NONE);
X
X vi$new_offset := 1;
X IF (CURRENT_OFFSET < vi$active_count) OR (CURRENT_OFFSET = 0) THEN
X vi$active_count := 0;
X RETURN (0);
X ENDIF;
X
X MOVE_HORIZONTAL (-vi$cur_active_count);
X vi$yank_mode := VI$IN_LINE_MODE;
X RETURN (vi$retpos (pos));
XENDPROCEDURE;
X
X!
X! Move right one location. Stop at the end of the line, but, do not
X! wrap at edge of the screen.
X!
XPROCEDURE vi$right
X
X LOCAL
X pos,
X line,
X offset;
X
X ! Ignore error messages
X
X ON_ERROR
X vi$active_count := 0;
X POSITION (pos);
X RETURN (0);
X ENDON_ERROR
X
X pos := MARK (NONE);
X
X line := CURRENT_LINE;
X offset := CURRENT_OFFSET;
X
X ! This makes it possible to use the "s" command at the end of the line.
X
X IF (vi$command_type = VI$CHANGE_TYPE) THEN
X offset := offset - 1;
X IF (LENGTH (CURRENT_LINE) = 0) THEN
X COPY_TEXT (" ");
X MOVE_HORIZONTAL (-1);
X vi$start_pos := MARK (NONE);
X ENDIF;
X ENDIF;
X
X IF (vi$active_count < (LENGTH (line) - offset -
X (vi$command_type = VI$OTHER_TYPE))) THEN
X MOVE_HORIZONTAL (vi$cur_active_count);
X ELSE
X vi$active_count := 0;
X RETURN (0);
X ENDIF;
X
X vi$new_offset := 1;
X
X vi$yank_mode := VI$IN_LINE_MODE;
X RETURN (vi$retpos (pos));
XENDPROCEDURE;
X
X!
X! Move up one row, staying in the same column. Scroll if necessary.
X!
XPROCEDURE vi$upline
X
X LOCAL
X pos,
X tabstops,
X offset,
X cur_off;
X
X ! Ignore error messages
X
X ON_ERROR
X vi$active_count := 0;
X POSITION (pos);
X RETURN (0);
X ENDON_ERROR;
X
X pos := MARK (NONE);
X
X tabstops := GET_INFO (CURRENT_BUFFER, "TAB_STOPS");
X
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X MOVE_HORIZONTAL (LENGTH(vi$current_line) + 1);
X vi$new_endpos := MARK(NONE);
X
X POSITION (pos);
X
X ! We must understand it (i.e. it must be an integer) inorder to process
X ! the tabs properly.
X
X IF (GET_INFO (tabstops, "TYPE") <> STRING) THEN
X offset := CURRENT_OFFSET;
X
X cur_off := GET_INFO (SCREEN, "CURRENT_COLUMN") - 1;
X MOVE_VERTICAL(-vi$cur_active_count);
X MOVE_HORIZONTAL (-CURRENT_OFFSET);
X
X IF vi$new_offset = 1 THEN
X vi$max_offset := cur_off;
X vi$new_offset := 0;
X ENDIF;
X
X IF (cur_off < vi$max_offset) THEN
X cur_off := vi$max_offset;
X ENDIF;
X
X ! Save the beginning of the line as the new beginning.
X
X vi$start_pos := MARK (NONE);
X vi$to_offset (CURRENT_LINE, cur_off, tabstops);
X ELSE
X MOVE_VERTICAL (-vi$cur_active_count);
X ENDIF;
X vi$yank_mode := VI$LINE_MODE;
X RETURN (vi$retpos (pos));
XENDPROCEDURE;
X
X!
X! Move the cursor to the offset given by 'offset' counting tabs as expanded
X! spaces.
X!
XPROCEDURE vi$to_offset (line, offset, tabstops)
X LOCAL
X cur_ch,
X col,
X diff,
X len,
X tab,
X idx;
X
X idx := 1;
X col := 0;
X len := LENGTH (line);
X tab := ASCII (9);
X
X LOOP
X EXITIF (len < idx) OR (col >= offset);
X IF (SUBSTR (line, idx, 1) = tab) THEN
X diff := (((col+tabstops)/tabstops)*tabstops)-col;
X ELSE
X diff := 1;
X ENDIF;
X col := col + diff;
X idx := idx + 1;
X ENDLOOP;
X
X ! Move N characters to the right.
X
X MOVE_HORIZONTAL (idx - 1);
XENDPROCEDURE;
X
X!
X! Search for a text string. This procedure is activated by typing
X! either a '/' or a '?'.
X!
XPROCEDURE vi$search (direction)
X LOCAL
X where,
X i,
X pos,
X ch,
X sstr,
X cnt,
X add_spec,
X prompt;
X
X pos := MARK (NONE);
X
X IF (direction > 0) THEN
X prompt := "/";
X ELSE
X prompt := "?";
X ENDIF;
X
X IF (vi$read_a_line (prompt, sstr) = 0) THEN
X RETURN (0);
X ENDIF;
X
X i := 1;
X LOOP
X EXITIF (i > LENGTH (sstr));
X ch := SUBSTR (sstr, i, 1);
X IF (ch = "\") THEN
X i := i + 1;
X ELSE
X EXITIF (ch = prompt);
X ENDIF;
X i := i + 1;
X ENDLOOP;
X
X add_spec := 0;
X IF (ch = prompt) THEN
X add_spec := SUBSTR (sstr, i+1, 255);
X sstr := SUBSTR (sstr, 1, i-1);
X MESSAGE("add_spec: "+add_spec);
X MESSAGE("sstr: "+sstr);
X ENDIF;
X
X IF (direction > 0) THEN
X SET (FORWARD, CURRENT_BUFFER);
X vi$last_search_dir := 1;
X MOVE_HORIZONTAL (1);
X ELSE
X SET (REVERSE, CURRENT_BUFFER);
X vi$last_search_dir := -1;
X ENDIF;
X
X IF sstr <> "" THEN
X vi$search_string := sstr;
X ELSE
X IF vi$search_string = 0 THEN
X vi$message ("No previous string to search for!");
X POSITION (pos);
X RETURN (0);
X ENDIF;
X ENDIF;
X
X ! On success then return the position we moved to.
X
X cnt := vi$cur_active_count;
X LOOP
X where := vi$find_str (vi$search_string, 0);
X EXITIF (where = 0);
X POSITION (BEGINNING_OF (where));
X IF (CURRENT_DIRECTION = FORWARD) THEN
X MOVE_HORIZONTAL (1);
X ELSE
X MOVE_HORIZONTAL (-1);
X ENDIF;
X cnt := cnt - 1;
X EXITIF cnt = 0;
X ENDLOOP;
X
X IF (where = 0) THEN
X vi$message ("String not found");
X ELSE
X IF add_spec <> 0 THEN
X POSITION (where);
X IF add_spec = "-" THEN
X add_spec := "-1";
X ELSE
X IF (SUBSTR (add_spec, 1, 1) = "+") THEN
X IF (add_spec = "+") THEN
X add_spec := "1";
X ENDIF;
X ELSE
X add_spec := SUBSTR (add_spec, 2, 255);
X ENDIF;
X ENDIF;
X
X i := INT (add_spec);
X MOVE_VERTICAL (i);
X vi$_bol;
X where := MARK (NONE);
X ENDIF;
X MESSAGE ("");
X ENDIF;
X
X POSITION (pos);
X RETURN (where);
XENDPROCEDURE;
X
X!
X! Search for the next occurence of the previously searched for string.
X! The procedure is actived by typing an 'n' or 'N' keystroke.
X!
XPROCEDURE vi$search_next (direction)
X LOCAL
X prompt,
X where,
X pos,
X cnt,
X sstr;
X
X pos := MARK (NONE);
X
X IF vi$search_string = 0 THEN
X vi$message ("No previous string to search for!");
X POSITION (pos);
X RETURN (0);
X ENDIF;
X
X IF (direction > 0) THEN
X prompt := "/" + vi$search_string;
X SET (FORWARD, CURRENT_BUFFER);
X IF (MARK (NONE) <> END_OF (CURRENT_BUFFER)) THEN
X MOVE_HORIZONTAL (1);
X ELSE
X IF (vi$wrap_scan = 1) THEN
X POSITION (BEGINNING_OF (CURRENT_BUFFER));
X ENDIF;
X ENDIF;
X ELSE
X prompt := "?" + vi$search_string;
X SET (REVERSE, CURRENT_BUFFER);
X IF (MARK (NONE) <> BEGINNING_OF (CURRENT_BUFFER)) THEN
X IF (SUBSTR (prompt, 1, 3) = "?\<") THEN
X MOVE_HORIZONTAL (-2);
X ELSE
X MOVE_HORIZONTAL (-1);
X ENDIF;
X ELSE
X IF (vi$wrap_scan = 1) THEN
X POSITION (END_OF (CURRENT_BUFFER));
X ENDIF;
X ENDIF;
X ENDIF;
X
X vi$message (prompt);
X
X ! On success then return the position we moved to.
X
X cnt := vi$cur_active_count;
X LOOP
X where := vi$find_str (vi$search_string, 0);
X EXITIF (where = 0);
X POSITION (BEGINNING_OF (where));
X IF (CURRENT_DIRECTION = FORWARD) THEN
X MOVE_HORIZONTAL (1);
X ELSE
X MOVE_HORIZONTAL (-1);
X ENDIF;
X cnt := cnt - 1;
X EXITIF cnt = 0;
X ENDLOOP;
X
X IF (where = 0) THEN
X vi$message ("String not found");
X ELSE
X vi$message ("");
X ENDIF;
X
X POSITION (pos);
X RETURN (where);
XENDPROCEDURE;
X
X!
X! This procedure can be used to find a string of text (using RE's).
X! The current direction of the BUFFER is used to determine which way
X! the search goes. 'replace' is used by the replace code to indicate
X! that wrap scan should be performed.
X!
XPROCEDURE vi$find_str (sstr, replace)
X LOCAL
X pos,
X new_pat,
X start,
X where;
X
X ON_ERROR
X ENDON_ERROR;
X
X pos := MARK (NONE);
X IF vi$magic THEN
X new_pat := vi$re_pattern_gen (sstr);
X ELSE
X new_pat := vi$pattern_gen (sstr);
X ENDIF;
X
X IF (new_pat <> 0) THEN
X EXECUTE (COMPILE ("vi$_find_pat := " + new_pat));
X where := SEARCH (vi$_find_pat, CURRENT_DIRECTION, vi$ignore_case);
X IF (where = 0) AND (vi$wrap_scan = 1) AND (replace = 0) THEN
X IF (CURRENT_DIRECTION = FORWARD) THEN
X POSITION (BEGINNING_OF (CURRENT_BUFFER));
X ELSE
X POSITION (END_OF (CURRENT_BUFFER));
X ENDIF;
X where := SEARCH (vi$_find_pat, CURRENT_DIRECTION, vi$ignore_case);
X ENDIF;
X ELSE
X where := 0;
X ENDIF;
X
X IF (where <> 0) AND (vi$in_ws) THEN
X POSITION (BEGINNING_OF (where));
X IF (CURRENT_OFFSET <> 0) OR
X (INDEX (vi$_ws, CURRENT_CHARACTER) <> 0) THEN
X MOVE_HORIZONTAL (1);
X ENDIF;
X start := MARK (NONE);
X POSITION (END_OF (where));
X IF (CURRENT_OFFSET <> LENGTH (CURRENT_LINE)) THEN
X MOVE_HORIZONTAL (-1);
X ENDIF;
X where := CREATE_RANGE (start, MARK (NONE), NONE);
X POSITION (pos);
X ENDIF;
X RETURN (where);
XENDPROCEDURE;
X
X!
X! Generate a TPU pattern string, not using RE's, i.e. :set nomagic is
X! in effect when this routine is used.
X!
XPROCEDURE vi$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 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 pos; ! The position within the regular
X ! expression string that we are examining
X ! currently
X
X IF (INDEX (pat, "$") <> 0) OR (INDEX (pat, "^") <> 0) THEN
X new_pat := "";
X ELSE
X new_pat := '"'+pat+'"';
X RETURN (new_pat);
X ENDIF;
X
X pos := 1;
X
X IF SUBSTR (pat, pos, 1) = "^" THEN
X IF LENGTH (pat > 1) THEN
X new_pat := "line_begin & '";
X ELSE
X new_pat := "line_begin";
X ENDIF;
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
X IF (cur_char = "$") AND (pos+1 >= LENGTH (pat)) THEN
X IF pos <> 1 THEN
X cur_pat := "' & line_end";
X ELSE
X cur_pat := "line_end";
$ GoSub Convert_File
$ Exit