MODULE TPUPlus_DIED IDENT "910131"
!
!   PROCEDURE EVE_DIR (CMD_LINE_ARG)
!   PROCEDURE UTL_DIED (ARG_DIR_EDIT_SPEC)
!   PROCEDURE UTL_DIR_EDIT_EDIT
!   PROCEDURE UTL_FIND_KML (KEY_LIST_NAME)
!   PROCEDURE UTL_COPY_KML (ARC_KML, DEST_KML)
!   PROCEDURE UTL_RCINDEX (ARC, SUB)
!   PROCEDURE UTL_SET_STATUS_LINE (WIN)
!

!****************************************
PROCEDURE EVE_DIR (CMD_LINE_ARG)

utl_previous_buffer := get_info (current_buffer, "name");
utl_died (cmd_line_arg);

ENDPROCEDURE;
!****************************************
PROCEDURE UTL_DIED (ARG_DIR_EDIT_SPEC)

local   len, 
        name_index, 
        dir_edit_spec, 
        dir_edit_buf, 
        file, 
        this_position,
        temp_edit_spec;

on_error
    message ("DIED error -- Can't reach specified directory");
    utl_dir_edit_fspec := '';
endon_error;

this_position   := mark (free_cursor);
dir_edit_spec   := arg_dir_edit_spec;

!dir_edit_buf    := utl_find_buffer ("DIED");    ! tst_if_buffer_exists ???
if test_if_buffer_exists ("DIED", dir_edit_buf) = 0 then
    dir_edit_buf := create_buffer ("DIED");
    set (eob_text, dir_edit_buf, "");
    set (no_write, dir_edit_buf);
    set (system, dir_edit_buf);
    set (margins, dir_edit_buf, 1, get_info (dir_edit_buf, "record_size") - 1);
    utl_dir_edit_fspec := '';
endif;

erase (dir_edit_buf);

! check to see if directory key map list exists if not, create it...
if utl_find_kml ("dir_edit_kml") = 0 then
    utl_copy_kml (get_info (key_map_list, "current"), "dir_edit_kml");
    create_key_map ("dir_edit_km");
    define_key ("utl_dir_edit_edit", 
            key_name ('g', shift_key), "died edit file",
            "dir_edit_km");
    add_key_map ("dir_edit_kml", "first", "dir_edit_km");
endif;

set (key_map_list, "dir_edit_kml", dir_edit_buf);

! The following operation will prompt for directory specs if none is supplied
! I would rather that the directory default to the current dir if none 
! is supplied, therefore the following code is commented-out.
!temp_edit_spec := dir_edit_spec;
!if eve$prompt_string (temp_edit_spec, dir_edit_spec,
!    "Dir Edit - RETURN = current dir, ^Z = quit > ", "Operation aborted") then
!    if last_key = ctrl_z_key then
!        utl_dir_edit_fspec := '';
!        return;
!    endif;
!endif;

!
! Parse the file spec...
!
utl_dir_edit_fspec := 
    file_parse (utl_dir_edit_fspec, "", "", node) +
    file_parse (utl_dir_edit_fspec, "", "", device) +
    file_parse (utl_dir_edit_fspec, "", "", directory);

utl_dir_edit_fspec := file_parse (dir_edit_spec, utl_dir_edit_fspec + "*.*;*");
if utl_dir_edit_fspec = "" then
    return;
endif;

file := file_search (utl_dir_edit_fspec);
if file = "" then
    message ("No match found for specified file criteria");
    return;
endif;

position (dir_edit_buf);

copy_text ("Directory of " + utl_dir_edit_fspec);
split_line;
copy_text ("Press <GOLD-G> to get the file cursor is positioned upon");
split_line;
split_line;

copy_text ("[-] Back up one directory level");
split_line;
copy_text ("<EXIT> Cancel DIR and return to previous buffer");
split_line;

loop
    name_index := index (file, "]");
    len     := length (file);
    file    := substr (file, name_index + 1, len - name_index);
    copy_text (file);
    split_line;
    file    := file_search (utl_dir_edit_fspec);
    exitif file = "";
endloop;

map (current_window, dir_edit_buf);
position (beginning_of (dir_edit_buf));
update (current_window);
move_vertical (4);
utl_set_status_line (current_window);

ENDPROCEDURE;
!****************************************
PROCEDURE UTL_DIR_EDIT_EDIT

local dir_edit_edit_buf, buf_name, dum, file, new_buf_name;

!message (fao ("file specs = !AS", utl_dir_edit_fspec));

utl_dir_edit_fspec :=
    file_parse (utl_dir_edit_fspec, "", "", node) +
    file_parse (utl_dir_edit_fspec, "", "", device) +
    file_parse (utl_dir_edit_fspec, "", "", directory);

!message (fao ("file specs = !AS after parse", utl_dir_edit_fspec));

if substr (current_line, 1, 3) = "[-]" then
    if index (utl_dir_edit_fspec, ".") = 0 then
        message ("You are already at the top of a directory tree");
        return;
    else
        dum := utl_rcindex (utl_dir_edit_fspec, ".");
        utl_dir_edit_fspec := substr (utl_dir_edit_fspec, 1, dum - 1) + "]";
        utl_died (utl_dir_edit_fspec);

!message (fao ("file specs = !AS after editing", utl_dir_edit_fspec));

        return;
    endif;
    return;
endif;

if substr (current_line, 1, 6) = "<EXIT>" then
    eve_buffer (utl_previous_buffer);
    return;
endif;

file    := file_parse (current_line, utl_dir_edit_fspec);
dum     := file_search ("");
file    := file_search (file);

if file = "" then
    message ("File name not selected");
    return;
endif;

if file_parse (file, '', '', type) = ".DIR" then
    subdir := substr (utl_dir_edit_fspec, 1, length (utl_dir_edit_fspec) - 1);
    subdir := subdir + "." + file_parse (file, '', '', name) + "]";
    utl_died (subdir);
    return;
endif;

buf_name := file_parse (file, "", "", name) + file_parse (file, "", "", type);
!dir_edit_edit_buf := utl_find_buffer (buf_name);
if test_if_buffer_exists(buf_name, dir_edit_edit_buf) <> 0 then
    new_buf_name := read_line ("Enter new name.  RETURN = replace, ^Z = cancel > ");
    edit (new_buf_name, trim);
    if last_key = ctrl_z_key then
        return;
    endif;
    if new_buf_name = '' then
        delete (dir_edit_edit_buf);
        dir_edit_edit_buf := create_buffer (buf_name, file);
    else
        dir_edit_edit_buf := create_buffer (new_buf_name, file);
    endif;
else
    dir_edit_edit_buf := create_buffer (buf_name, file);
endif;

position (beginning_of (dir_edit_edit_buf));
map (current_window, dir_edit_edit_buf);
utl_set_status_line (current_window);

if eag_map_lock = 1 then
    eag_show_map;
endif;

ENDPROCEDURE;
!****************************************
PROCEDURE UTL_FIND_KML (KEY_LIST_NAME)

local upcased_name, km_list;

upcased_name := key_list_name;
change_case (upcased_name, upper);
km_list     := get_info (key_map_list, 'first');

loop
    exitif km_list = 0;
    exitif upcased_name = km_list;
    km_list := get_info (key_map_list, 'next');
endloop;

return km_list;

ENDPROCEDURE;
!****************************************
PROCEDURE UTL_COPY_KML (ARC_KML, DEST_KML)

local km, kml_new;

if utl_find_kml (arc_kml) = 0 then
    message ("COPY_KML -- Source key map list does not exist - no copy done");
    return 0;
endif;

km := get_info (key_map, "first", arc_kml);
if km = 0 then
    message ("COPY_KML -- Source key map list empty - no copy done");
    return 0;
endif;

if utl_find_kml (dest_kml) <> 0 then
    add_key_map (dest_kml, "last", km);
else
    create_key_map_list (dest_kml, km);
endif;

loop
    km := get_info (key_map, "next", arc_kml);
    exitif km = 0;
    add_key_map (dest_kml, "last", km);
endloop;

ENDPROCEDURE;
!****************************************
PROCEDURE UTL_RCINDEX (ARC, SUB)

local idx, new_idx, tmp;

idx := 0;
tmp := arc;

loop
    new_idx := index (tmp, sub);
    exitif new_idx = 0;
    tmp     := substr (tmp, new_idx + 1, length (tmp) - new_idx);
    idx     := idx + new_idx;
endloop;

return (idx);

ENDPROCEDURE;
!****************************************
PROCEDURE UTL_SET_STATUS_LINE (WIN)

local msg_buf_name;

on_error
endon_error;

msg_buf_name := get_info (message_buffer, "name");
if msg_buf_name = "MESSAGES" then
    eve$set_status_line (win);
!else
!    if msg_buf_name = "$MESSAGES" then
!        lse$set_status_line (win);
!    endif;
endif;

return;

ENDPROCEDURE;

eve$arg1_dir        := "string";

ENDMODULE;