!Last Modified: 6-JAN-1989 10:11:27.41, By: FLEMING !+Redefinition of keys could lead to problems at a later date 7/15/86 ! RECCUTPAS.TPU - Eve version of rectangular cut and paste !- ! ! TPU emulation of rectangular CUT/PASTE including following routines: ! EVE_DRAW_BOX ! EVE_RECTANGULAR_REMOVE ! EVE_RECTANGULAR_INSERT_HERE ! EVE_RECTANGULAR_SELECT ! EVEPLUS_PAD_BLANK ! EVE_SET_RECTANGULAR ! EVE_SET_NORECTANGULAR ! EVEPLUS_SET_MODE ! EVEPLUS_BLANK_CHARS ! EVEPLUS_ADVANCE_HORIZONTAL ! ! 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 in paste_buffer. PASTE can then be done to overstrike the ! rectangular region in 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 need 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. ! ! GLOBAL VARIABLES created/used ! eveplus_v_begin_select - position where selected region begins ! ! GLOBAL VARIABLES used ! current_buffer ! paste_buffer ! ! This TPU file rebinds the SELECT/REMOVE/INSERT HERE keys to the included ! routines and initializes the eveplus_v_begin_select variable when the ! eve_set_rectangular procedure is executed. The standard Eve key bindings ! are restored when the eve_set_norectangular procedure is executed. ! procedure eveplus_reccutpas_module_ident return "V50.001"; endprocedure; procedure eve_rectangle_module_init eveplus_v_begin_select := 0; endprocedure; !+ ! Procedure to calculate the current column from the current offset, treating ! TAB characters as up to 8 blanks. !- PROCEDURE edd_current_column LOCAL i, line, col; line := current_line; IF INDEX(line,ASCII(9)) = 0 THEN return(current_offset); ELSE i := blanks_added_by_tabs(999); i := i+current_offset; return(i); ENDIF ENDPROCEDURE ! Procedure to calculate how many blanks would be added to the ! current line by replacing tabs with blanks out to the target ! column. The result is the (virtual # blanks) - (# tab chars). PROCEDURE blanks_added_by_tabs(target_length) LOCAL i, col, tab_pos, mod_blanks, blanks_added, cur_length, new_line_length, old_line, eight_blanks, mark_begin, loc_range, tab_char ; blanks_added := 0; !+ ! Make sure we're not on the EOB marker. !- old_line := substr(current_line,1,current_offset); IF MARK(NONE) <> END_OF(CURRENT_BUFFER) THEN new_line_length := 0 ; tab_char := ascii(9); i := 1; col := 0; LOOP tab_pos := index(old_line,tab_char); !any tabs in the line? exitif(tab_pos = 0); ! calculate number of blanks to replace tab with tab_calc := new_line_length+tab_pos ; exitif tab_calc > target_length ; mod_blanks := (tab_calc - ((tab_calc/8)*8)); ! mod from division if mod_blanks = 0 then mod_blanks := 1 else mod_blanks := 9-mod_blanks; endif; blanks_added := blanks_added + mod_blanks-1 ; new_line_length := new_line_length + tab_pos-1 + mod_blanks ; old_line := substr(old_line,tab_pos+1,length(old_line)); exitif(old_line = eve$kt_null);! there was a tab on the eoln endloop; ENDIF; return blanks_added ; 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 edd_replace_tabs_with_blanks_and_pad(target_length) LOCAL i, col, tab_pos, mod_blanks, cur_length, new_line,old_line, old_length, eight_blanks, tab_char ; !+ ! Make sure we're not on the EOB marker. !- IF MARK(NONE) <> END_OF(CURRENT_BUFFER) THEN old_line := current_line; old_length := length(old_line); if (old_length = 0) then !encountered a null line COPY_TEXT(fao("!#* ",target_length )); MOVE_HORIZONTAL(-CURRENT_OFFSET); return; endif; new_line := ''; eight_blanks := " "; ! assume 1 tab = 8 blanks tab_char := ascii(9); i := 1; col := 0; if index(old_line,tab_char) <> 0 then LOOP tab_pos := index(old_line,tab_char); !any tabs in the line? if (tab_pos = 0) then !we done new_line := new_line + old_line; exitif(tab_pos = 0); else ! calculate number of blanks to replace tab with tab_calc := length(new_line)+tab_pos ; mod_blanks := (tab_calc - ((tab_calc/8)*8)); ! mod from division if mod_blanks = 0 then mod_blanks := 1 else mod_blanks := 9-mod_blanks; endif; new_line := new_line + substr(old_line,1,tab_pos-1); new_line := new_line + substr(eight_blanks,1,mod_blanks); old_line := substr(old_line,tab_pos+1,length(old_line)); exitif(old_line = eve$kt_null);! there was a tab on the eoln endif; endloop; ENDIF ; ! end of check for any tabs MOVE_HORIZONTAL(-CURRENT_OFFSET); if (new_line = eve$kt_null) then copy_text(old_line); ! no tabs were ever found ERASE_CHARACTER(old_length); else ! else we found at least one tab ERASE_CHARACTER(old_length); COPY_TEXT(new_line); endif; ENDIF; !+ ! 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(fao("!#* ",(target_length - cur_length))); ENDIF; MOVE_HORIZONTAL(-CURRENT_OFFSET) ENDPROCEDURE PROCEDURE eve_draw_box LOCAL saved_mode, end_column, start_column, temp, end_select, top_bottom_text; !+ ! Check for no select active !- IF eveplus_v_begin_select = 0 THEN MESSAGE("Select not active"); RETURN ENDIF; !+ ! Set INSERT mode !- saved_mode := eveplus_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. !- eveplus_pad_blank; IF MARK(NONE) >= eveplus_v_begin_select THEN end_select := MARK(NONE) ELSE end_select := eveplus_v_begin_select; eveplus_v_begin_select := MARK(NONE); POSITION(end_select) ENDIF; !+ ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEPLUS_V_BEGIN_SELECT. Figure out ! the start column. !- end_column := edd_current_column; POSITION(eveplus_v_begin_select); eveplus_v_begin_select := MARK(NONE); start_column := edd_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(eveplus_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 := '+' + eveplus_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. !- edd_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. !- edd_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. !- edd_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(eveplus_v_begin_select); eveplus_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_remove LOCAL saved_mode, end_select, end_column, start_column, temp, pad_chars, save_position, blank_chars, cut_text; !+ ! Check for no select active !- IF eveplus_v_begin_select = 0 THEN MESSAGE("Select not active"); RETURN ENDIF; !+ ! Set INSERT mode and erase PASTE_BUFFER !- saved_mode := eveplus_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. !- eveplus_pad_blank; IF MARK(NONE) >= eveplus_v_begin_select THEN end_select := MARK(NONE) ELSE end_select := eveplus_v_begin_select; eveplus_v_begin_select := MARK(NONE); POSITION(end_select) ENDIF; !+ ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEPLUS_V_BEGIN_SELECT. Figure out ! the start column. !- end_column := edd_current_column; POSITION(eveplus_v_begin_select); eveplus_v_begin_select := MARK(NONE); start_column := edd_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 := eveplus_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. !- edd_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(-CURRENT_OFFSET); MOVE_VERTICAL(1); ! MOVE_HORIZONTAL(1); ! position to next line in paste !+ ! 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(eveplus_v_begin_select); eveplus_v_begin_select := 0; MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_HORIZONTAL(start_column); SET(saved_mode, CURRENT_BUFFER); ENDPROCEDURE PROCEDURE eve_rectangular_insert_here !+ ! This procedure pastes the rectangular region in the paste buffer ! using the current position in the current buffer as the upper left corner. !- LOCAL save_position, start_column, paste_line, save_buffer, save_mode; save_buffer := CURRENT_BUFFER; save_position := MARK(NONE); start_column := edd_current_column; save_mode := eveplus_set_mode(OVERSTRIKE); POSITION(BEGINNING_OF(paste_buffer)); IF MARK(NONE) = END_OF(paste_buffer) THEN MESSAGE("Paste buffer is empty"); RETURN ENDIF; !+ ! Loop through 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); edd_replace_tabs_with_blanks_and_pad(start_column+length(paste_line)); !+ ! 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 EVE_RECTANGULAR_SELECT if eveplus_v_begin_select = 0 then eveplus_pad_blank; eveplus_v_begin_select := mark(REVERSE); message("Selection started. Press Remove when finished."); else eveplus_v_begin_select := 0; message("Selection cancelled"); endif; endprocedure ! eve_rectangular_select PROCEDURE EVEPLUS_PAD_BLANK !+ ! 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 EDD, we really want a mark in a particular screen column. In TPU, ! an EOL mark would move if the line were extended. Also in EDD, 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. !- 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 ! eveplus_pad_blank Procedure EVE_SET_RECTANGULAR eveplus_v_begin_select := 0; endprocedure Procedure EVE_SET_NORECTANGULAR eveplus_v_begin_select := 0; if (get_info(screen,"VT200") = 1) then define_key("eve_remove", e3, "remove"); define_key("eve_insert_here", e2, "insert_here"); define_key("eve_select", e4, "select"); endif; endprocedure PROCEDURE EVEPLUS_SET_MODE(new_mode) !+ ! This procedure returns the current mode for the current buffer ! and sets it to the value in NEW_MODE. !- eveplus_set_mode := get_info(current_buffer,"MODE"); set(new_mode, current_buffer); endprocedure ! eveplus_set_mode PROCEDURE EVEPLUS_BLANK_CHARS(eveplus_v_blank_count) !+ ! This procedure returns a string of eveplus_v_blank_count blank chars. !- IF eveplus_v_blank_count = 0 THEN RETURN ""; else RETURN fao("!#* ",eveplus_v_blank_count); endif; endprocedure; ! eveplus_blank_chars PROCEDURE EVEPLUS_ADVANCE_HORIZONTAL(eveplus_v_columns,eveplus_v_blank_chars) !+ ! This procedure advances current_offset to be eveplus_v_columns from ! current_offset. eveplus_v_blanks_chars must be ! a string of blank chars of at least length eveplus_v_columns. !- local eveplus_v_save_offset, ! current_offset on entry to this procedure eveplus_v_eol_columns; ! Number of columns to [EOL] eveplus_v_save_offset := current_offset; if eveplus_v_columns <= 0 then move_horizontal(eveplus_v_columns); else !+ ! Find out how far to [EOL]. !- eveplus_v_eol_columns := length(current_line)-current_offset; if eveplus_v_eol_columns >= eveplus_v_columns then move_horizontal(eveplus_v_columns); else move_horizontal(eveplus_v_eol_columns); copy_text(substr(eveplus_v_blank_chars,1, eveplus_v_columns-eveplus_v_save_offset)); endif; endif; endprocedure ! eveplus_advance_horizontal ! procedure to insert blanks before the area indicated by the ! rectangular select. By using eve_rectangular_pad you can shift ! columns to the right. ! PROCEDURE eve_rectangular_pad LOCAL saved_mode, end_select, end_column, start_column, temp, pad_chars, save_position, blank_chars, len, cut_text; !+ ! Check for no select active !- IF eveplus_v_begin_select = 0 THEN MESSAGE("Select not active"); RETURN ENDIF; !+ ! Set INSERT mode and erase PASTE_BUFFER !- saved_mode := eveplus_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. !- eveplus_pad_blank; IF MARK(NONE) >= eveplus_v_begin_select THEN end_select := MARK(NONE) ELSE end_select := eveplus_v_begin_select; eveplus_v_begin_select := MARK(NONE); POSITION(end_select) ENDIF; !+ ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEPLUS_V_BEGIN_SELECT. Figure out ! the start column. !- end_column := edd_current_column; POSITION(eveplus_v_begin_select); eveplus_v_begin_select := MARK(NONE); start_column := edd_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 := eveplus_blank_chars(end_column - start_column + 1); len := 0; len := end_column-start_column+1; !+ ! MOVE_HORIZONTAL(-len); SET(INSERT, current_buffer); LOOP EXITIF MARK(NONE) > end_select; COPY_TEXT(pad_chars); MOVE_HORIZONTAL(-len); MOVE_VERTICAL(1) ENDLOOP; !+ ! Position to the beginning of the cut area, reset BEGIN_SELECT, ! restore old insert/overstrike setting !- POSITION(eveplus_v_begin_select); eveplus_v_begin_select := 0; MOVE_HORIZONTAL(-CURRENT_OFFSET); MOVE_HORIZONTAL(start_column); SET(saved_mode, CURRENT_BUFFER); ENDPROCEDURE ; ! position to the end of a column if whitespace is null backup one procedure eve_skip_column(buffer_right_margin) local tab_character,this_character,ok; ok := 0; this_character := current_character; tab_character := ascii(9); !bug index function doesn't find tabs!! loop ! skip over the column to the blank space exitif(ok); this_character := current_character; if (index(eve$x_fill_separators,this_character)=0) and (this_character <> tab_character) and (this_character <> eve$kt_null) then move_horizontal(1); else ok := 1; endif; if (current_offset = buffer_right_margin) then message("EOLN this_position went past EOL"); return(0); endif; endloop; return(1); endprocedure ; ! skip the space between columns and position at the begining of a column procedure eve_skip_white_space(buffer_right_margin) local ok,this_character,tab_character; ok := 0; tab_character := ascii(9); !bug index function doesn't find tabs!! loop ! skip whitespace this_character := current_character; ! call function once exitif(ok); if (index(eve$x_fill_separators,this_character) <> 0) or (tab_character = this_character) then move_horizontal(1); else ok := 1; endif; if (current_offset = buffer_right_margin) then message("EOLN marker went past EOL"); return(0); endif; endloop; return(1); endprocedure ! create blanks so that inserted column doesn't overwrite its' neighbor ! beginning select marker will also be shifted so it will be replaced ! by a new one after the return procedure eve_pad_column(len,selector) local pad_chars; pad_chars := eveplus_blank_chars(len); ! create the padding SET(INSERT, current_buffer); LOOP EXITIF MARK(NONE) > selector; COPY_TEXT(pad_chars); ! add in blanks MOVE_HORIZONTAL(-len); MOVE_VERTICAL(1); ENDLOOP; endprocedure ; ! Page 19 ! Insert (not overstrike) spaces from current position until given column. ! If current offset greater than column, do nothing. ! ! Parameters: ! ! which_column Column to go to - input procedure eve$to_column (which_column) local this_buffer, ! Current buffer this_mode, ! Keyword for current mode distance; ! Number of spaces needed this_buffer := current_buffer; this_mode := get_info (this_buffer, eve$kt_mode); set (insert, this_buffer); loop distance := which_column - get_info (this_buffer, eve$kt_offset_column); exitif distance <= 0; if distance > length (eve$kt_spaces) then copy_text (eve$kt_spaces); else copy_text (substr (eve$kt_spaces, 1, distance)); endif; endloop; set (this_mode, this_buffer); endprocedure !+ ! SORT.TPU !-! ! ! ! Sort the named buffer. Prompt for buffer name if not specified ! procedure eve_sort_by_col local sort_buffer ,key_size, end_select, end_column, start_column, first_row, last_row, sort_range, temp; IF eveplus_v_begin_select = 0 THEN MESSAGE("Rectangular select not active"); RETURN ENDIF; !+ ! 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. !- IF MARK(reverse) >= eveplus_v_begin_select THEN end_select := MARK(NONE); ELSE end_select := eveplus_v_begin_select; eveplus_v_begin_select := MARK(NONE); ENDIF; !+ ! Figure out what column the box ends in and set END_COLUMN there. ! Then, clear out the video on EVEPLUS_V_BEGIN_SELECT. Figure out ! the start column. !- end_column := get_info(end_select,"offset"); start_column := get_info(eveplus_v_begin_select,"offset"); !+ ! 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; !+ ! Create a buffer to sort in !- sort_buffer := create_buffer('sort_buffer'); !+ !+ ! mark the range that includes the area to sort and ! cut the entire range of rows to the sort buffer !- position(eveplus_v_begin_select); move_horizontal( - current_offset); first_row := mark(none); position(end_select); position (search (line_end, FORWARD)); last_row := mark(none); sort_range := create_range (first_row, last_row, reverse); position( sort_buffer ); move_text (sort_range); !+ ! Set up and call sort_by_col !- key_size := 1 + end_column - start_column; eveplus$$shell_sort_by_col (sort_buffer, 1 + start_column, key_size); !+ ! Put the contents of the sort buffer back into the original place !- position(first_row); move_text( sort_buffer ); delete(sort_buffer); eveplus_v_begin_select := 0; endprocedure ! ! ! This is the shell sort, described in knuth and also ! referred to as the Diminishing Increment Sort. ! procedure eveplus$$shell_sort_by_col (buffer_to_sort, start_column, key_size) local v_pos ,v_iline ,v_jline ,v_i ,v_j ,v_record ; on_error position (v_pos); return; endon_error; v_pos := mark (none); position (buffer_to_sort); eveplus$x_shellstep_0 := 1; eveplus$x_shellstep_1 := 4; eveplus$x_shellstep_2 := 13; eveplus$x_shellstep_3 := 40; eveplus$x_shellstep_4 := 121; eveplus$x_shellstep_5 := 364; eveplus$x_shellstep_6 := 1093; eveplus$x_shellstep_7 := 3280; eveplus$x_shellstep_8 := 9841; eveplus$x_shellstep_9:= 32767; eveplus$x_gshell := 0; eveplus$x_shell_index := 0; ! ! Find the highest step to use ! loop eveplus$x_gshell := 0; exitif (eveplus$x_shell_index >= 6); execute ("if (get_info (current_buffer, 'record_count') <"+ fao ("eveplus$x_shellstep_!UL)",eveplus$x_shell_index+2)+ " then eveplus$x_gshell := 1;endif;"); if eveplus$x_gshell then exitif 1; endif; eveplus$x_shell_index := eveplus$x_shell_index + 1; endloop; v_record := get_info (current_buffer, 'record_count'); ! ! Now we can sort the buffer. Outer loop loops over all the steps, ! decrementing eveplus$x_shell_index. ! loop execute (fao("eveplus$x_gshell := eveplus$x_shellstep_!UL", eveplus$x_shell_index)); v_j := eveplus$x_gshell + 1; !Set up loop for step+1-index loop position (beginning_of (current_buffer)); move_vertical (v_j - 1); !Get j'th line v_jline := current_line; v_i := v_j - eveplus$x_gshell; !i = j - h loop position (beginning_of (current_buffer)); move_vertical (v_i - 1); v_iline := current_line; if (eveplus$$string_compare ( substr(v_jline,start_column,key_size), substr(v_iline,start_column,key_size) ) >= 0) then position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_jline); exitif 1; else position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_iline); v_i := v_i - eveplus$x_gshell; if (v_i < 1) then position (beginning_of (current_buffer)); move_vertical (v_i + eveplus$x_gshell - 1); erase_line; split_line; move_vertical (-1); copy_text (v_jline); exitif 1; endif; endif; endloop; v_j := v_j + 1; exitif (v_j > v_record); endloop; eveplus$x_shell_index := eveplus$x_shell_index - 1; exitif (eveplus$x_shell_index < 0); endloop; position (v_pos); endprocedure ! ! Compare two strings ! ! Returns: ! 1 if string1 > string2 ! 0 if string1 = string2 ! -1 if string1 < string2 ! procedure eveplus$$string_compare (string1, string2) local v_alpha, v_c1, v_p1, v_c2, v_i, v_p2; v_alpha := " " + !Treat all control chars as spaces??? " " + " !""#$%&'()*+,-./"+ "0123456789:;<=>?" + "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_" + "`abcdefghijklmnopqrstuvwxyz{|}~"; v_i := 1; loop if (length (string2) < v_i) then if (length (string2) = length (string1)) then return 0 else return 1 endif; endif; if (length (string1) < v_i) then return -1; endif; v_c1 := substr (string1, v_i, 1); change_case (v_c1, upper); v_c2 := substr (string2, v_i, 1); change_case (v_c2, upper); v_p1 := index (v_alpha, v_c1); v_p2 := index (v_alpha, v_c2); if (v_p1 < v_p2) then return -1; endif; if (v_p1 > v_p2) then return 1; endif; v_i := v_i + 1; endloop; return 1; endprocedure