!++
! FILENAME: SORT.TPU
! FUNCTION: This file contains procedures for performing a shell sort on a
!           buffer.
! 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:     26-AUG-1987 Original.
! HISTORY:  current.
! CONTENTS:
!           evedt_sort (bname,astring)
!           eve_sort_buffer (buffer_to_sort)
!           evedt$$string_compare (string1, string2)
!           evedt$$shell_sort (buffer_to_sort)
!
!23456789A123456789B123456789C123456789D123456789E123456789F123456789G123456789H
!--
!*----------------------------------------------------------------------------*!

procedure sort_module_ident 

  local file_date,
        module_vers;

  file_date := "-<( 15-NOV-1988 14:25:14.18 )>-";
  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;

!*----------------------------------------------------------------------------*!

procedure evedt_sort (bname,astring)

  evedt$$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 := evedt_find_buffer (v_buf);
if (p_buf <> 0)
then
    evedt$$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 evedt$$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 evedt$$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);
evedt$x_shellstep_0 := 1;
evedt$x_shellstep_1 := 4;
evedt$x_shellstep_2 := 13;
evedt$x_shellstep_3 := 40;
evedt$x_shellstep_4 := 121;
evedt$x_shellstep_5 := 364;
evedt$x_shellstep_6 := 1093;
evedt$x_shellstep_7 := 3280;
evedt$x_shellstep_8 := 9841;
evedt$x_shellstep_9:= 32767;
evedt$x_gshell := 0;
evedt$x_shell_index := 0;
!
! Find the highest step to use
!
loop
    evedt$x_gshell := 0;
    exitif (evedt$x_shell_index >= 6);
    execute ("if (get_info (current_buffer, 'record_count') <"+
        fao ("evedt$x_shellstep_!UL)",evedt$x_shell_index+2)+
        " then evedt$x_gshell := 1;endif;");
    if evedt$x_gshell
        then exitif 1; endif;
    evedt$x_shell_index := evedt$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 evedt$x_shell_index.
!
loop
    execute (fao("evedt$x_gshell := evedt$x_shellstep_!UL",
                evedt$x_shell_index));
    v_j := evedt$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 - evedt$x_gshell;          !i = j - h
        loop
            position (beginning_of (current_buffer));
            move_vertical (v_i - 1);
            v_iline := current_line;
            if (evedt$$string_compare (v_jline, v_iline) >= 0)
            then
                position (beginning_of (current_buffer));
                move_vertical (v_i + evedt$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 + evedt$x_gshell - 1);
                erase_line;
                split_line;
                move_vertical (-1);
                copy_text (v_iline);
                v_i := v_i - evedt$x_gshell;
                if (v_i < 1)
                then
                    position (beginning_of (current_buffer));
                    move_vertical (v_i + evedt$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;
    evedt$x_shell_index := evedt$x_shell_index - 1;
    exitif (evedt$x_shell_index <  0);
    endloop;
position (v_pos);
endprocedure