! FETCH_FILE.TPU -- Get a file

! This file can be incorporated with EVEplus.
! Written by Valerie H. Matthews (SUPER::MATTHEWS) -- comments welcome.

! This is a modified eve_get_file. The differences are:

!	It gives you the option of clobbering the buffer if it already
!	    exists. (This is the sole reason for this procedure's existence;
!           the other stuff is just icing.)

! 	It always gets the file, even if you're already editing it.

!	It tells you whether an existing buffer is modified.

!	If the new buffer name you give it also exists, it keeps
!	    on asking for a buffer name.

! I called it eve_fetch_file in case you want to preserve the behavior of
! eve_get_file. If you rename it eve_get_file to replace the existing one,
! it still works just fine.
!	Edit History
!
!	Which	When		Who 	What
!
!	X00-01	14-May-85	vhm	Created from eve_get_file

procedure eve_fetch_file (get_file_parameter)

local get_file_name,		! Local copy of get_file_parameter
      temp_buffer_name,		! String for buffer name based on get_file_name
      file_search_result,	! Latest string returned by file_search
      temp_file_name,		! First file name string returned by file_search
      loop_buffer,		! Buffer currently being checked in loop
      new_buffer,		! New buffer created if needed
      found_a_buffer;		! True if buffer found with same name

on_error
    if error = tpu$_parsefail then
	message (fao ("Don't understand file name: !AS", get_file_name));
	if eve$x_starting_up then
	    eve$set_status_line (current_window);
	endif;
	return;
    endif;
endon_error;

if eve$check_bad_window then
    message ("Cursor has been moved to a text window; try command again");
    return;
endif;

if not (eve$prompt_string (get_file_parameter, get_file_name,
			   "File to get: ", "No file specified")) then
    return;
endif;

! Protect against earlier file_search with same file name.

file_search_result := file_search (eve$x_null);
temp_file_name := eve$x_null;
erase (eve$choice_buffer);
! Flesh out with full file spec, using default device and directory
! if they are defined.
if get_info(eve$default_dir,"type") = UNSPECIFIED then
	eve$default_dir := eve$kt_null;
endif;
get_file_name := file_parse (get_file_name,eve$default_dir);


loop
    file_search_result := file_search (get_file_name);
    exitif file_search_result = eve$x_null;
    eve$add_choice (file_search_result);
    temp_file_name := file_search_result;
endloop;

if get_info (eve$choice_buffer, "record_count") > 1 then

    ! If get_file is called from tpu$init_procedure, can't handle
    ! multiple choices, so set status line on main window and return

    if eve$x_starting_up then
	eve$set_status_line (current_window);
    endif;
    eve$display_choices (fao ("Ambiguous file name: !AS", get_file_name));
    return;
endif;

! See if we already have a buffer by that name

if temp_file_name = eve$x_null then
    temp_buffer_name :=
	file_parse (get_file_name, eve$x_null, eve$x_null, name) +
	file_parse (get_file_name, eve$x_null, eve$x_null, type);
else
    temp_buffer_name :=
	file_parse (temp_file_name, eve$x_null, eve$x_null, name) +
	file_parse (temp_file_name, eve$x_null, eve$x_null, type);
endif;

loop
    loop_buffer := get_info (buffers, "first");
    found_a_buffer := 0;
    loop
        exitif loop_buffer = 0;
        if temp_buffer_name = get_info (loop_buffer, "name") then
        	found_a_buffer := 1;
        	exitif 1;
        endif;
        loop_buffer := get_info (buffers, "next");
    endloop;

! If no buffer of that name exists, we drop out of the loop and
! go get the file.

    exitif not found_a_buffer; ! Buffer name doesn't exist yet

! If a buffer of that name already exists (loop_buffer points to it),
! we ask for a new name. We also warn the user if it's modified.

    if get_info (loop_buffer, "modified") then
        message (fao ("Buffer !AS is in use and modified", temp_buffer_name));
    else
        message (fao ("Buffer !AS is in use", temp_buffer_name));
    endif;
    temp_buffer_name :=
            read_line ("Type a new buffer name or press Return to clobber: ");

! If new name is null, we retain the existing name of buffer loop_buffer.
! We're going to have to delete loop_buffer and create a new one.

    if temp_buffer_name = eve$x_null then    ! if no new name, get the old one
        temp_buffer_name := get_info (loop_buffer, "name");
        buffer_map_count := get_info (loop_buffer, "map_count");

! When we clobber a buffer, the trick is not to delete it if it's mapped
! to a window, because strange things happen if we do. First we go to the
! window it's mapped to, if any. Then we make sure it's mapped to only one
! window. Then we map buffer "MAIN" (arbitrary choice) to the current window.
! Then we can delete the buffer we want to delete. (The buffer that gets created
! later will come up in the current window.)

        if buffer_map_count <> 0 then    ! If loop_buffer not mapped, we're OK
            if eve$x_number_of_windows >= 2 then ! If only one window, we're OK
		 loop	! Switch windows till we find right one
                   exitif get_info (current_window, "buffer")
                               = loop_buffer;
		   message("Moving to window containing buffer to be replaced");
                   eve_next_window;  ! it must be in an other window
		 endloop;
            endif;
            eve_buffer("main");
        endif;
        delete (loop_buffer);        ! It will have to come out, Mr. Gumby
        exitif 1;                    ! Now go ahead & create new buffer
    endif;

    eve$cleanse_string (temp_buffer_name);
    change_case (temp_buffer_name, upper);   ! buffer names are uppercase
endloop;

! Now we can go ahead and create the new buffer with the file we were
! asked to get.

new_buffer := eve$create_buffer
        (temp_buffer_name, get_file_name, temp_file_name);

if new_buffer <> 0 then
    set (eob_text, new_buffer, "[End of file]");
    set (margins, new_buffer, eve$x_default_left_margin,
	 get_info (current_window, "width") - eve$x_default_right_margin);
endif;

! Correct the status line in any event

eve$set_status_line (current_window);

endprocedure;

! If you rename this procedure eve_get_file, this tpu_local_init
! is unnecessary.

procedure tpu$local_init

    eve$arg1_fetch_file := eve$arg1_get_file;

endprocedure;