!+
! SORT.TPU 
!-!
!
procedure eveplus_sort (bname,astring)
eveplus$$shell_sort(bname);
endprocedure

!
! Sort the named buffer.  Prompt for buffer name if not specified
!
procedure eve_sort_buffer (buffer_to_sort)
local	v_buf
	,p_buf;
if not eve$prompt_string (buffer_to_sort, v_buf, "Sort buffer: ", "Cancelled")
    then return; endif;

p_buf := eveplus_find_buffer (v_buf);
if (p_buf <> 0)
then
    eveplus$$shell_sort (p_buf);
else
    message ("Buffer "+v_buf+" not found");
    endif;
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
!           
! This is the shell sort, described in knuth and also
! referred to as the Diminishing Increment Sort.
!
procedure eveplus$$shell_sort (buffer_to_sort)
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 (v_jline, v_iline) >= 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

procedure tpu$local_init
eve$arg1_sort_buffer := eve$arg1_buffer;
endprocedure

tpu$local_init;