!++ ! FILENAME: RECTANGULAR.TPU ! FUNCTION: This file contains procedures which give the user horizontal and ! vertical editing tools. ! ! Rectangular CUT/PASTE provides a way to select a corner of a ! rectangular region on the screen that is to be CUT. This select ! point is highlighted in reverse video. The cursor can then be ! positioned to the opposite corner of the box at which point the CUT ! can be done to place the rectangular region into the paste_buffer. ! PASTE can then be done to overstrike the rectangular region in the ! paste_buffer onto the current_buffer using the current position as ! the upper left corner for the pasted region. Note that no provision ! is made if there are TAB chars in the current buffer. Also, no ! provision is made if the cut or paste is done with part of the ! region to be cut or pasted over not being visible on the screen. ! ! These procedures can be run with the current buffer set to ! overstrike or insert mode - CUT/PASTE needs to switch to insert ! mode temporarily to get the chars replaced properly, but the ! previous mode setting for the current buffer is restored when ! either the cut or paste routine completes. ! ! These procedures rebind the SELECT/REMOVE/INSERT HERE keys to the ! included routines and initializes the evedt_v_begin_select variable ! then the eve_set_rectangular procedure is executed. The standard ! EVE key bindings are restored when the eve_set_norectangular ! procedure is executed. ! ! AUTHOR: Steven K. Shapiro, (C) Copyright SKS Enterprises, Austin TX. ! All Rights Reserved. ! ! The format, structure and contents of this file are the sole ! property of Steven K. Shapiro and are copyrighted to SKS ! Enterprises, Austin Texas. ! ! The information may be freely distributed, used and modified ! provided that the information in this header block is not ! changed, altered, disturbed or modified in any way. ! ! DATE: 30-NOV-1986 Original. ! HISTORY: current. ! CONTENTS: ! evedt_current_column ! evedt_replace_tabs_with_blanks_and_pad(target_length) ! eve_draw_box ! eve_rectangular_select ! evedt_pad_blank ! eve_set_rectangular ! eve_set_norectangular ! evedt_set_mode(new_mode) ! evedt_blank_chars(evedt_v_blank_count) ! evedt_advance_horizontal(evedt_v_columns,evedt_v_blank_chars) ! eve_fill_chars(evedt_v_blank_count) ! eve_fill_rectangular ! eve_rectangular_remove ! eve_rectangular_insert_here ! tpu$init_proc_evedt ! !23456789A123456789B123456789C123456789D123456789E123456789F123456789G123456789H !-- !*----------------------------------------------------------------------------*! procedure rectangular_module_ident local file_date, module_vers; file_date := "-<( 2-DEC-1988 09:01:18.51 )>-"; module_vers := substr(file_date,5,2) + substr(file_date,8,3) + substr(file_date,14,2) + substr(file_date,17,5) ; return module_vers; endprocedure; !*----------------------------------------------------------------------------*! ! ! This procedure will calculate the current column from the current offset, ! treating TAB characters as up to 8 blanks. PROCEDURE evedt_current_column LOCAL i, line, col; line := current_line; IF INDEX(line,ASCII(9)) = 0 THEN evedt_current_column := current_offset ELSE i := 1; col := 0; LOOP EXITIF i > current_offset; IF SUBSTR(line,i,1) = ASCII(9) THEN col := ((col + 8)/8)*8 ELSE col := col + 1 ENDIF; i := i + 1 ENDLOOP; evedt_current_column := col ENDIF ENDPROCEDURE !*----------------------------------------------------------------------------*! ! Procedure to replace TAB characters by the appropriate number of ! blanks on the current line, then pad the line out to a given length, if it ! is shorter. The routine assumes overstrike mode is in ! effect. It leave the current position at the beginning of the line. PROCEDURE evedt_replace_tabs_with_blanks_and_pad(target_length) LOCAL i, col, cur_length, new_line, eight_blanks; ! Make sure we're not on the EOB marker. IF MARK(NONE) <> END_OF(CURRENT_BUFFER) THEN IF INDEX(CURRENT_LINE, ASCII(9)) <> 0 THEN new_line := ''; eight_blanks := " "; i := 1; col := 0; LOOP EXITIF i > LENGTH(CURRENT_LINE); IF SUBSTR(CURRENT_LINE,i,1) = ASCII(9) THEN col := ((col + 8)/8)*8; new_line := new_line + SUBSTR(eight_blanks,1,col-LENGTH(new_line)) ELSE new_line := new_line + SUBSTR(CURRENT_LINE,i,1); col := col + 1 ENDIF; i := i + 1 ENDLOOP; MOVE_HORIZONTAL(-CURRENT_OFFSET); COPY_TEXT(new_line) ENDIF ENDIF; MOVE_HORIZONTAL(-CURRENT_OFFSET); ! Now pad out the line if we have to IF MARK(NONE) = END_OF(CURRENT_BUFFER) THEN cur_length := 0 ELSE cur_length := LENGTH(CURRENT_LINE) ENDIF; IF cur_length < target_length THEN MOVE_HORIZONTAL(cur_length); COPY_TEXT(evedt_blank_chars(target_length - cur_length)); ENDIF; MOVE_HORIZONTAL(-CURRENT_OFFSET) ENDPROCEDURE !*----------------------------------------------------------------------------*! ! ! Draw a box around the rectangular marks. ! SKS 30-NOV-1988 Added mods to handle the HARD margins which appeared in ! release V2.0 of TPU. ! PROCEDURE eve_draw_box LOCAL saved_mode, end_column, start_column, temp, end_select, l_margin, start_pos, end_pos, the_range, saved_left_margin, top_bottom_text; ! Check for no select active IF evedt_v_begin_select = 0 THEN MESSAGE("Rectangular select not active."); RETURN ENDIF; ! Set INSERT mode saved_mode := evedt_set_mode(INSERT); ! Make sure there is a character at the corner of the box opposite ! the begin_select mark. If the end_select mark is before the ! begin_select mark, juggle the markers so that begin_select precedes ! end_select. evedt_pad_blank; IF MARK(NONE) >= evedt_v_begin_select THEN end_select := MARK(NONE); ELSE end_select := evedt_v_begin_select; evedt_v_begin_select := MARK(NONE); POSITION(end_select); ENDIF; ! SKS 1-DEC-1988 ! If the left margin is not 1, then remove HARD ! margins from range (if any). saved_left_margin := get_info(current_buffer, "left_margin"); IF saved_left_margin > 1 THEN the_range := create_range(beginning_of(current_buffer), end_of(current_buffer), none); eve_user_strip_margins ( the_range ); ENDIF; position(end_select); ! SKS 1-DEC-1988 ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEDT_V_BEGIN_SELECT. Figure out ! the start column. end_column := evedt_current_column; POSITION(evedt_v_begin_select); evedt_v_begin_select := MARK(NONE); start_column := evedt_current_column; ! We may have the upper right and lower left corners of the box ! selected. If so, START_COLUMN and END_COLUMN need to be reversed. IF start_column > end_column THEN temp := end_column; end_column := start_column; start_column := temp ENDIF; ! We may be building the box on the first line of the buffer. In ! that case, we must put a new top line in the buffer. MOVE_HORIZONTAL(-CURRENT_OFFSET); IF MARK(NONE) = BEGINNING_OF(CURRENT_BUFFER) THEN SPLIT_LINE; POSITION(BEGINNING_OF(CURRENT_BUFFER)); COPY_TEXT(evedt_blank_chars(start_column)); MOVE_VERTICAL(1); MOVE_HORIZONTAL(-CURRENT_OFFSET) ENDIF; ! Move back one line and put in the top line of the box top_bottom_text := '+' + evedt_blank_chars(end_column-start_column+1) + '+'; TRANSLATE(top_bottom_text, "-", " "); SET(OVERSTRIKE, current_buffer); MOVE_VERTICAL(-1); ! Replace all TABs with blanks on this line and pad it, if we need to. evedt_replace_tabs_with_blanks_and_pad(end_column + 1); IF start_column <> 0 THEN MOVE_HORIZONTAL(start_column - 1) ENDIF; COPY_TEXT(top_bottom_text); MOVE_VERTICAL(1); MOVE_HORIZONTAL(-CURRENT_OFFSET); ! Step through the selected lines, putting vertical bars on either side ! of the selected text. LOOP EXITIF MARK(NONE) > end_select; ! Replace all TABs with blanks on this line, if we need to. evedt_replace_tabs_with_blanks_and_pad(end_column + 1); ! If START_COLUMN is zero, we must insert a vertical bar to do the ! left column, then put the right vertical bar one column farther out ! than normal. IF start_column = 0 THEN SET(INSERT, CURRENT_BUFFER); COPY_TEXT("|"); SET(OVERSTRIKE, CURRENT_BUFFER); MOVE_HORIZONTAL(end_column + 1); ELSE MOVE_HORIZONTAL(start_column-1); COPY_TEXT("|"); MOVE_HORIZONTAL(end_column - CURRENT_OFFSET + 1) ENDIF; COPY_TEXT("|"); MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_VERTICAL(1) ENDLOOP; ! Now put in the bottom line of the box. ! Replace all TABs with blanks on this line, if we need to. evedt_replace_tabs_with_blanks_and_pad(end_column + 1); IF start_column <> 0 THEN MOVE_HORIZONTAL(start_column - 1) ENDIF; COPY_TEXT(top_bottom_text); ! Position to the beginning of the cut area, reset BEGIN_SELECT, ! restore old insert/overstrike setting POSITION(evedt_v_begin_select); evedt_v_begin_select := 0; MOVE_HORIZONTAL(-CURRENT_OFFSET); IF start_column = 0 THEN MOVE_HORIZONTAL(1) ELSE MOVE_HORIZONTAL(start_column) ENDIF; SET(saved_mode, CURRENT_BUFFER) ENDPROCEDURE !*----------------------------------------------------------------------------*! PROCEDURE EVE_RECTANGULAR_SELECT if evedt_v_begin_select = 0 then evedt_pad_blank; evedt_v_begin_select := mark(REVERSE); message("Rectangular Selection started. Press Remove when finished."); set(informational,off); evedt_key ("eve_rectangular_remove",kp6,"rectangular remove",eve$kt_null); evedt_key ("eve_rectangular_insert_here", key_name(kp6,shift_key), "rectangular insert here",eve$kt_null); set(informational,on); else evedt_v_begin_select := 0; message("Rectangular Selection cancelled"); endif; endprocedure ! eve_rectangular_select !*----------------------------------------------------------------------------*! ! ! This procedure drops a space at the current position if the current ! character is null so that any mark will be for an existing character. ! In EVEDT, we really want a mark in a particular screen column. In TPU, ! an EOL mark would move if the line were extended. Also in EVEDT, we ! want to highlight the select point so we need a character there. ! The cursor is returned to its original position after the space is ! copied to the current position in the current buffer. PROCEDURE EVEDT_PAD_BLANK IF MARK(NONE) = END_OF(CURRENT_BUFFER) THEN copy_text(" "); move_horizontal(-1) ELSE if current_character = "" then copy_text(" "); move_horizontal(-1); endif ENDIF ENDPROCEDURE ! evedt_pad_blank !*----------------------------------------------------------------------------*! PROCEDURE EVE_SET_RECTANGULAR if eve$x_select_position <> 0 then eve$x_select_position := 0; message("Selection cancelled"); endif; evedt_v_begin_select := 0; ENDPROCEDURE !*----------------------------------------------------------------------------*! PROCEDURE EVE_SET_NORECTANGULAR if evedt_v_begin_select <> 0 then evedt_v_begin_select := 0; message("Rectangular Selection cancelled"); endif; set(informational,off); !evedt_restore_key("rectnglr_remove_key"); !evedt_restore_key("rectnglr_insert_key"); !evedt_restore_key("rectnglr_select_key"); set(informational,on); ENDPROCEDURE !*----------------------------------------------------------------------------*! ! ! This procedure returns the current mode for the current buffer ! and sets it to the value in NEW_MODE. PROCEDURE EVEDT_SET_MODE(new_mode) evedt_set_mode := get_info(current_buffer,"MODE"); set(new_mode, current_buffer); ENDPROCEDURE ! evedt_set_mode !*----------------------------------------------------------------------------*! ! ! This procedure returns a string of evedt_v_blank_count blank chars. PROCEDURE EVEDT_BLANK_CHARS(evedt_v_blank_count) local evedt_v_blank_chars, evedt_v_oldlen, evedt_v_blanks_so_far; ! Length of blank char string so far IF evedt_v_blank_count = 0 THEN RETURN "" ENDIF; evedt_v_blank_chars := " "; evedt_v_blanks_so_far := 1; loop exitif evedt_v_blanks_so_far >= evedt_v_blank_count; evedt_v_oldlen := LENGTH(evedt_v_blank_chars); evedt_v_blank_chars := evedt_v_blank_chars + evedt_v_blank_chars; evedt_v_blanks_so_far := evedt_v_blanks_so_far + evedt_v_oldlen; endloop; IF evedt_v_blanks_so_far > evedt_v_blank_count THEN evedt_v_blank_chars := SUBSTR(evedt_v_blank_chars,1,evedt_v_blank_count) ENDIF; RETURN evedt_v_blank_chars ENDPROCEDURE ! evedt_blank_chars !*----------------------------------------------------------------------------*! ! ! This procedure advances current_offset to be evedt_v_columns from ! current_offset. evedt_v_blanks_chars must be ! a string of blank chars of at least length evedt_v_columns. PROCEDURE EVEDT_ADVANCE_HORIZONTAL(evedt_v_columns,evedt_v_blank_chars) local evedt_v_save_offset, ! current_offset on entry to this procedure evedt_v_eol_columns; ! Number of columns to [EOL] evedt_v_save_offset := current_offset; if evedt_v_columns <= 0 then move_horizontal(evedt_v_columns); else ! Find out how far to [EOL]. evedt_v_eol_columns := length(current_line)-current_offset; if evedt_v_eol_columns >= evedt_v_columns then move_horizontal(evedt_v_columns); else move_horizontal(evedt_v_eol_columns); copy_text(substr(evedt_v_blank_chars,1, evedt_v_columns-evedt_v_save_offset)); endif; endif; ENDPROCEDURE ! evedt_advance_horizontal !*----------------------------------------------------------------------------*! ! ! This procedure returns a string of evedt_v_blank_count user specified ! characters. PROCEDURE EVE_FILL_CHARS(evedt_v_blank_count) local eve_fill_char, evedt_v_oldlen, evedt_v_blanks_so_far; ! Length of blank char string so far IF evedt_v_blank_count = 0 THEN RETURN "" ENDIF; eve_fill_char := read_line("Type the character to fill: "); evedt_v_blanks_so_far := 1; loop exitif evedt_v_blanks_so_far >= evedt_v_blank_count; evedt_v_oldlen := LENGTH(eve_fill_char); eve_fill_char := eve_fill_char + eve_fill_char; evedt_v_blanks_so_far := evedt_v_blanks_so_far + evedt_v_oldlen; endloop; IF evedt_v_blanks_so_far > evedt_v_blank_count THEN eve_fill_char := SUBSTR(eve_fill_char,1,evedt_v_blank_count) ENDIF; RETURN eve_fill_char ENDPROCEDURE ! evedt_blank_chars !*----------------------------------------------------------------------------*! ! ! SKS 30-NOV-1988 Added mods to handle the HARD margins which appeared in ! release V2.0 of TPU. PROCEDURE eve_fill_rectangular LOCAL saved_mode, end_select, end_column, start_column, temp, pad_chars, save_position, blank_chars, l_margin, start_pos, end_pos, the_range, saved_left_margin, cut_text; ! Check for no select active IF evedt_v_begin_select = 0 THEN MESSAGE("Select not active"); RETURN ENDIF; ! Set INSERT mode and erase PASTE_BUFFER saved_mode := evedt_set_mode(INSERT); ERASE(paste_buffer); ! Make sure there is a character at the corner of the box opposite ! the begin_select mark. If the end_select mark is before the ! begin_select mark, juggle the markers so that begin_select precedes ! end_select. evedt_pad_blank; IF MARK(NONE) >= evedt_v_begin_select THEN end_select := MARK(NONE); ELSE end_select := evedt_v_begin_select; evedt_v_begin_select := MARK(NONE); POSITION(end_select); ENDIF; ! SKS 1-DEC-1988 ! If the left margin is not 1, then remove HARD ! margins from range (if any). saved_left_margin := get_info(current_buffer, "left_margin"); IF saved_left_margin > 1 THEN the_range := create_range(beginning_of(current_buffer), end_of(current_buffer), none); eve_user_strip_margins ( the_range ); ENDIF; position(end_select); ! SKS 1-DEC-1988 ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEDT_V_BEGIN_SELECT. Figure out ! the start column. end_column := evedt_current_column; POSITION(evedt_v_begin_select); evedt_v_begin_select := MARK(NONE); start_column := evedt_current_column; ! We may have the upper right and lower left corners of the box ! selected. If so, START_COLUMN and END_COLUMN need to be reversed. IF start_column > end_column THEN temp := end_column; end_column := start_column; start_column := temp ENDIF; ! Get a string of the appropriate number of blanks to paste back in pad_chars := eve_fill_chars(end_column - start_column + 1); ! Step through the selected lines, copying the text to the paste buffer ! and replacing it with blanks as we go. Replace all TABs with blanks ! before we look at it so we get the columns straight. MOVE_HORIZONTAL(-current_offset); SET(OVERSTRIKE, current_buffer); LOOP EXITIF MARK(NONE) > end_select; ! Replace all TABs with blanks on this line, if we need to. evedt_replace_tabs_with_blanks_and_pad(end_column + 1); ! Obtain the text we're cutting cut_text := SUBSTR(CURRENT_LINE, start_column + 1, end_column - start_column + 1); ! Replace the text with blanks MOVE_HORIZONTAL(start_column); COPY_TEXT(pad_chars); ! Copy the text to the paste buffer save_position := MARK(NONE); POSITION(paste_buffer); COPY_TEXT(cut_text); MOVE_HORIZONTAL(1); ! Reposition to the other buffer and move to the next line POSITION(save_position); MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_VERTICAL(1) ENDLOOP; ! Position to the beginning of the cut area, reset BEGIN_SELECT, ! restore old insert/overstrike setting POSITION(evedt_v_begin_select); evedt_v_begin_select := 0; MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_HORIZONTAL(start_column); SET(saved_mode, CURRENT_BUFFER) ENDPROCEDURE !*----------------------------------------------------------------------------*! ! ! Remove the rectangular area specified. ! SKS 1-DEC-1988, modifications as necessary to remove HARD margins. ! PROCEDURE eve_rectangular_remove local first_line, saved_mode, end_select, end_column, start_column, temp, pad_chars, save_position, blank_chars, the_range, saved_left_margin, cut_text; first_line := false; ! Check for no select active IF evedt_v_begin_select = 0 THEN message("select not active"); return ENDIF; ! Set INSERT mode and erase PASTE_BUFFER saved_mode := evedt_set_mode(INSERT); erase(paste_buffer); ! Make sure there is a character at the corner of the box opposite ! the begin_select mark. If the end_select mark is before the ! begin_select mark, juggle the markers so that begin_select precedes ! end_select. evedt_pad_blank; IF mark(none) >= evedt_v_begin_select THEN end_select := mark(none); ELSE end_select := evedt_v_begin_select; evedt_v_begin_select := mark(none); position(end_select); ENDIF; ! SKS 1-DEC-1988 ! If the left margin is not 1, then remove HARD ! margins from range (if any). saved_left_margin := get_info(current_buffer, "left_margin"); IF saved_left_margin > 1 THEN the_range := create_range(beginning_of(current_buffer), end_of(current_buffer), none); eve_user_strip_margins ( the_range ); ENDIF; position(end_select); ! SKS 1-DEC-1988 ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEDT_V_BEGIN_SELECT. Figure out ! the start column. end_column := evedt_current_column; position(evedt_v_begin_select); evedt_v_begin_select := MARK(NONE); start_column := evedt_current_column; ! We may have the upper right and lower left corners of the box ! selected. If so, START_COLUMN and END_COLUMN need to be reversed. IF start_column > end_column THEN temp := end_column; end_column := start_column; start_column := temp ENDIF; ! Get a string of the appropriate number of blanks to paste back in pad_chars := evedt_blank_chars(end_column - start_column + 1); ! Step through the selected lines, copying the text to the paste buffer ! and replacing it with blanks as we go. Replace all TABs with blanks ! before we look at it so we get the columns straight. move_horizontal(-current_offset); set(overstrike, current_buffer); loop exitif mark(none) > end_select; ! Replace all TABs with blanks on this line, if we need to. evedt_replace_tabs_with_blanks_and_pad(end_column + 1); ! Obtain the text we're cutting cut_text := SUBSTR(CURRENT_LINE, start_column + 1, end_column - start_column + 1); ! Replace the text with blanks move_horizontal(start_column); copy_text(pad_chars); ! Copy the text to the paste buffer save_position := MARK(NONE); ! save the line to be deleted into the delete_buffer for safety. position (end_of (delete_buffer)); if first_line = true ! split line only if first line being added then split_line; first_line := true; endif; copy_text(cut_text); position(save_position); position(paste_buffer); copy_text(cut_text); move_horizontal(1); ! Reposition to the other buffer and move to the next line position(save_position); move_horizontal(-current_offset); move_vertical(1) endloop; ! Position to the beginning of the cut area, reset BEGIN_SELECT, ! restore old insert/overstrike setting position(evedt_v_begin_select); evedt_v_begin_select := 0; move_horizontal(-current_offset); move_horizontal(start_column); set(saved_mode, current_buffer) ENDPROCEDURE !*----------------------------------------------------------------------------*! ! ! This procedure pastes the rectangular region in the paste buffer ! using the current position in the current buffer as the upper left corner. ! ! SKS 1-DEC-1988, modifications as necessary to remove HARD margins. PROCEDURE eve_rectangular_insert_here LOCAL save_position, start_column, paste_line, save_buffer, cur_pos, start_line, end_line, the_range, saved_left_margin, save_mode; save_buffer := CURRENT_BUFFER; save_position := MARK(NONE); cur_pos := MARK(NONE); start_column := evedt_current_column; save_mode := evedt_set_mode(OVERSTRIKE); ! SKS 1-DEC-1988 ! If the left margin is not 1, then remove HARD ! margins from range (if any). saved_left_margin := get_info(current_buffer, "left_margin"); IF saved_left_margin > 1 THEN the_range := create_range(beginning_of(current_buffer), end_of(current_buffer), none); eve_user_strip_margins ( the_range ); ENDIF; ! SKS 1-DEC-1988 POSITION(BEGINNING_OF(paste_buffer)); IF MARK(NONE) = END_OF(paste_buffer) THEN MESSAGE("Paste buffer is empty"); RETURN; ENDIF; ! Loop through all lines in the paste buffer, putting them at the ! appropriate offset in the current buffer. LOOP EXITIF MARK(NONE) = END_OF(paste_buffer); ! Get the current line of the paste buffer. paste_line := CURRENT_LINE; MOVE_VERTICAL(1); ! Convert tabs to blanks on the line in the current buffer. POSITION(save_buffer); evedt_replace_tabs_with_blanks_and_pad(start_column+1); ! Position at the correct offset and overwrite the text there. MOVE_HORIZONTAL(start_column); COPY_TEXT(paste_line); MOVE_VERTICAL(1); POSITION(paste_buffer); ENDLOOP; ! Position to start of pasted text and restore old mode setting. POSITION(save_position); MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_HORIZONTAL(start_column); SET(save_mode, CURRENT_BUFFER); ENDPROCEDURE !*----------------------------------------------------------------------------*! PROCEDURE tpu$init_proc_evedt evedt_v_begin_select := 0 ENDPROCEDURE