!Last Modified:  13-JUN-1989 15:12:04.26, By: FLEMING 
!
procedure eag_get_file ! Get a file and update the window map
if current_window = eag_map_window then
	position ( eve$x_this_window );
endif;
eve_get_file ('');
!if eag_map_lock = 1 then
!	eag_show_map;
!endif;
endprocedure

Procedure eve_output_file_name(;input_buffer)

local 	work_buffer,	! local copy
	work_file_name,
	buffer_name;
on_error
 message(fao("EVE_OUTPUT_FILE_NAME, !AS on line: !SL",error_text,error_line));
endon_error;
	
! if no buffer was specified then the current one is the one

if get_info(input_buffer,"type")=UNSPECIFIED then
	work_buffer := get_info(current_window,"buffer");
Else
	work_buffer := input_buffer;
endif;

! what is the name of the buffer are we supposed to get the output file name
! for?

  buffer_name := get_info(work_buffer,"name");

! What does TPU think the output file name is?

work_file_name := get_info(work_buffer,"output_file");
if (get_info(work_file_name,'type') <> string) 
then
	work_file_name := ''; 
endif;

! if the output file name is null then try the input file name

if work_file_name = eve$kt_null then
	work_file_name := get_info(work_buffer,"file_name"); 

! make sure that the output file name is a string 

	if (get_info(work_file_name,'type') <> string)
	then
		work_file_name := ""; 
	endif;
endif;

! combine output name with buffer, but set version to ;
! the user can specify a version later by simply entering just the ver #
! at the prompt
!
! if no file type supplied in buffer name then supply .TXT -- default file type

  buffer_name := file_parse(buffer_name,".TXT");

! if no file name let parse use the buffer name
  eve_output_file_name := file_parse(";",work_file_name,buffer_name);

  return;
endprocedure;
! Write the current buffer to a specified file.  If no file specified,
! use the default file name.
!
!
! Write the current buffer to a specified file.  If no file specified,
! use the default file name.
!
! Parameters:
!
!	write_file_name		! String containing file name - input

procedure rtp$eve_write_file (;write_file_name,write_buffer)

local	result_file_name,
	write_result,
	skippy_asking,
	saved_buffer,
	work_buffer, ! File name string returned by write_file
	this_file,
	rtp$loc_save_position, ! save position before writing buffer
	work_buffer_name,
	work_range;
on_error
	[TPU$_NOSELECT]: ; ! get rid of spurious no range selected error
	[TPU$_CONTROLC]: eve$learn_abort;
			 abort;
	[OTHERWISE]: message(fao("EVE_WRITE_FILE, !AS on line: !SL",
				error_text,error_line));
			return(0); ! tell em the bad news
endon_error;
skippy_asking := 0; ! don't forget to ask
! EVE Version 2.0 eve$write_file worries about a "format_arg" which it
! never uses. Until DEC worries about we won't-- don't worry... be happy!
! see if a buffer or range was supplied
update(current_window);
rtp$loc_save_position := mark(none); ! stupid write file will position to the 
				 ! top of the buffer causing current position 
				 ! to be lost, so we must save our place

case get_info(write_buffer,"type")
 
 [unspecified]:

 [range] :
	work_range := write_buffer;
				
 [buffer] :
	work_buffer := write_buffer
endcase;

! see if a file name was supplied in the call

case  get_info(write_file_name,"TYPE") 

 [ UNSPECIFIED ] :
     write_file_name := eve$kt_null;
  [ string] :   ! filename string specified see if buffer exists
		! parse the name
	if write_file_name <> eve$kt_null
	then
 	        result_file_name := file_parse(write_file_name);
		if (work_buffer = 0) then ! if buffer not specified by user
 		 work_buffer := get_info(BUFFER,"find_buffer",write_file_name);
		endif;
		if (work_buffer <> 0) then  ! if buffer really exists

		  ! write it out with the filename supplied
		  set (output_file,work_buffer,result_file_name);
		else ! else assume current buffer is to be written
		  set (output_file,current_buffer,result_file_name);
		endif;
	endif;
  [ OTHERWISE ] :
  message('EVE_WRITE_FILE: There was a non-null valid parameter supplied ');
  message("WRITE_FILE_NAME is of type "+rlb_type_name(write_file_name));
  result_file_name := write_file_name;
  message("WRITE_FILE_NAME = '"+result_file_name+"'");
endcase ;
if write_file_name = eve$kt_null
then
     if (work_range = 0) then
	 work_range := select_range;
     endif;
     ! code to enable writing of a select range to a file
     if (work_range <> 0) then

! get a file name... you can't use the current buffer name to write it

	this_file := read_line('File name for the selected range:  ');
	edit(this_file,upper,trim);
	if this_file = eve$kt_null 
	then 
		return(1); 
	endif;
	result_file_name := file_parse(this_file,'.txt');
	work_buffer := create_buffer(result_file_name);
	set(OUTPUT_FILE,work_buffer,result_file_name);
	save_buffer := current_buffer;
	position(work_buffer);
	copy_text(work_range);
	position(save_buffer);
     else ! default case 
	! if we don't have a buffer then default to current one
	if (work_buffer = 0) then
		work_buffer := get_info(current_window,"buffer");
	endif;
	work_buffer_name := get_info(work_buffer,"name");
	if not get_info(work_buffer,'modified') then
	   	this_file := substr(read_line('Buffer '+work_buffer_name+
		' has not been modified, write anyway? <cr>=N')+' ',1,1);
   		edit(this_file,upper);
	   	if (this_file<>'Y') 
		then 
			return(1); ! allow exit to keep on going
		endif
	endif;
!	if we made it this far buffer was modified or user wants to write
!	it anyway
       	result_file_name := eve_output_file_name(work_buffer);
	if ((index(result_file_name,"MAIL") <> 0) and
	    ((index(result_file_name,"EDIT") <> 0) or
	     (index(result_file_name,"SEND") <> 0)))
	then ! chances are user is in mail, skip prompt
		skippy_asking := 1; ! set a variable so that TPU compiler
				    ! evaluation order ok see p3-9
	endif;
	! we only eat 1 brand of peanut butter -- and it's crunchy!
	if (skippy_asking = 0) 
	then
		this_file := 
			read_line("Write filename <CR="+result_file_name+">: ");
		case this_file
		 [eve$kt_null]: ! if NULL don't parse
		 ['N','n']:	return; !user chickened out
		 [OTHERWISE]:	 
			! the parse here allows the user to override any 
			! portion  or all of the file name.

			result_file_name := 
				file_parse(this_file,result_file_name);
			set(output_file,work_buffer,result_file_name);
		endcase;
	else
		set(output_file,work_buffer,result_file_name);
	endif;
! assume that since they put in a new file name that they want to set
! it as the default.
	if get_info(work_buffer,"type") = BUFFER then 
		set(output_file,work_buffer,result_file_name);
    	endif;
     endif;
endif;
eve_update_mod_date(work_buffer); ! if something bad happens here then 
				  ! forget about commenting and keep going

if eve$x_trimming then
    message ("Trimming buffer...");
    eve$trim_buffer (work_buffer);
    message ("Trimming completed");
endif;
write_result := write_file (work_buffer, result_file_name);
position(rtp$loc_save_position); ! return to where we were before write file
			     ! jerked us around
! if we have written a select range delete temp buffer, and clear select
if (work_range <> 0) then
	delete(work_buffer);
	eve$x_select_position := 0;
endif;	
update(current_window);
return(1); ! assume on_error caught anything wrong with write_file
endprocedure;

!
! EVEPLUS_WRITE_FILE procedure 
!
procedure eveplus_write_file
local write_file_name;

	write_file_name := TPU$K_UNSPECIFIED;
	rtp$eve_write_file(write_file_name,current_buffer);
	
endprocedure;

procedure eve$exit			! Actual EVE exit

local   
	the_buffer,		! Buffer to be checked and written
	the_file,		! File name to write it to
	got_a_file,		! Boolean set if buffer has assoc'd file
	the_buffer_name;	! Name of the buffer to write it to

on_error
    [TPU$_CONTROLC]:
	eve$learn_abort;
	abort;
endon_error;
if get_info (eve$prompt_window, "buffer") <> 0
then
    eve$message (EVE$_CANTEXIT);
    eve$learn_abort;
    return (FALSE);
endif;

the_file := "";
the_buffer := current_buffer;
if get_info (the_buffer, "modified") and not get_info (the_buffer,
						       "no_write")
then
	if not rtp$eve_write_file (the_file,the_buffer)
	then
	    eve$message (EVE$_CANTWRITE, 0,
			 substr (get_info (the_buffer, "name"), 1,
				 eve$x_max_buffer_name_length));
	endif;
endif;

the_buffer := get_info (BUFFERS, "first");
loop
    exitif the_buffer = 0;
    if ((the_buffer <> current_buffer) and
	(get_info (the_buffer, "modified")) and
	(not get_info (the_buffer, "no_write")))
    then
	the_buffer_name := substr (get_info (the_buffer, "name"),
				   1, eve$x_max_buffer_name_length);
	if eve$insist_y_n (message_text (EVE$_WRITEBUF, 1, the_buffer_name))
	then
		if not rtp$eve_write_file (the_file,the_buffer)
		then
		! if you can't write this buffer don't abort!!!
		! try to write the rest of the buffers in the hope that
		! something will get out.
		    eve$message (EVE$_CANTWRITE, 0, the_buffer_name);
		endif;
	endif;
    endif;
    the_buffer := get_info (BUFFERS, "next");
endloop;
! Delete all modified buffers so we can use EXIT without TPU prompting
! (need to return %TPU-S-EXITING for callable interface)

the_buffer := get_info (BUFFERS, "first");
loop
    exitif the_buffer = 0;
    if get_info (the_buffer, "modified") and
	(not get_info (the_buffer, "no_write"))
    then						! delete causes "next"
	delete (the_buffer);				! to return 0, must
	the_buffer := get_info (BUFFERS, "first");	! restart from "first"
    else
	the_buffer := get_info (BUFFERS, "next");
    endif;
endloop;
exit;
endprocedure



! eve$rtp_interactive_get_file allows user to position over a filename to
! perform operations. User can select a file, delete a file, or set default
! to a directory. This routine is dependent on call_user code currently
! written in Pascal.
procedure	eve$rtp_interactive_get_file(get_file_name)
local
      file_parse_result,	! Used to search for a file_parse filename
      prompt,			! ask if they want to really delete the file?
      answer,			! answer to the question
      word_range,		! range of a word
      dir_pattern,		! search pattern for Director xxx:[zzz]
      dir_range,		! result of that search
      rtp$saved_separators,
      eve$$$kt_word_separators; ! minimal word separators for word file search

	on_error
		message(ERROR_TEXT);
		eve_toggle_white_map;
		abort;
	endon_error;
	! if user hit select or delete keys
	if ((LAST_KEY = PERIOD) or (LAST_KEY = E4) or 
	    (LAST_KEY = KP6) or (LAST_KEY = E3)) then
		! nothing in the buffer
		if (mark(none) = end_of(current_buffer)) then
			message("[EOB] not able to get file");
			return;
		endif;
		!setup for minimal word separators
		eve$$$kt_word_separators := " " + ascii (9) + 
						ascii (12) +
			      ascii (13) + ascii (11) + ascii (10);
		rtp$saved_separators := eve$read_word_separators;
		eve$replace_word_separators(eve$$$kt_word_separators);
		word_range := eve$current_word;
		eve$replace_word_separators(rtp$saved_separators);
		get_file_name := substr(word_range,1,256);
		if (get_file_name = eve$kt_null) then
			message("Blank filename try again");
			return;
		endif;
		! if there isn't a directory spec then try to find one
		if (file_parse(get_file_name,"","[*]",DIRECTORY) = "[*]")
		then	
			dir_pattern := 'Directory ' & REMAIN;
			dir_range := search_quietly(dir_pattern, REVERSE);
			if (dir_range <> 0) then
			  get_file_name := substr(dir_range,11,256) + 
				get_file_name;		
			else
 			  message("%EVEPLUS-E-NOFILEPAT no filename found");
			  return;
			endif;
		endif;
	
		! possible file deletion
		if ((LAST_KEY = KP6) or (LAST_KEY = E3)) then
			if (file_parse(get_file_name,"","",NAME) = eve$kt_null)
			then
				message("%EVEplus-E-NOTFILE not a file");
				return;
			endif;
			! make sure the user really wants to delete
			prompt := "Really delete file--";
			prompt := prompt+get_file_name;
			prompt := prompt+" (Y,N <CR=N>): ";
			answer := read_line(prompt);
			if ((answer = "NO") or (answer = "N") or 
				(answer = "")) then
				eve_toggle_white_map;
				abort;
				return;
			endif;
			! else lets delete the bugger
			eve$replace_word_separators(eve$$$kt_word_separators);
			file_parse_result := 
				call_user(rtp$calluser_delete_file,
						get_file_name);
			eve_erase_previous_word; ! delete it from the buffer
			eve$replace_word_separators(rtp$saved_separators);
			message (fao ("Deleted file: !AS", get_file_name));
			get_file_name := eve$kt_null;
			return;
		endif; !end delete file
!	if filename is just a device:[dir] spec, then try setting default to it
	file_parse_result := file_parse(get_file_name,"","",NAME);
	if (file_parse_result = eve$kt_null) then
		file_parse_result := call_user(rtp$calluser_set_default,
						get_file_name);
		message (fao ("Set default to: !AS", get_file_name));
		!get rid of subproc pointing to old default
		delete(eve$x_dcl_process); 
		get_file_name := eve$kt_null; ! signal a set default to caller
		return; ! don't need to do anything else
	endif;
   endif; ! last key hit indicated a null op
endprocedure;

! Edit a file in the current window.  If the file is already in a buffer,
! use the old buffer.  If not, create a new buffer.
!
! Parameters:
!
!	get_file_parameter	String containing file name - input

procedure eve_get_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
      file_parse_result,	! Used to search for a file_parse filename
      temp_file_name,		! First file name string returned by file_search
      loop_buffer,		! Buffer currently being checked in loop
      file_count,		! Number of files matching the spec
      temp_answer,		! Answer to "Create file?"
      new_buffer,		! New buffer created if needed
      found_a_buffer,		! True if buffer found with same name
      want_new_buffer,		! True if file should go into a new buffer
      dir_range,		! result of that search
      eve$$$kt_word_separators; ! minimal word separators for word file search
on_error
    [TPU$_CONTROLC]:
	eve$learn_abort;
	abort;
    [TPU$_SEARCHFAIL]:
	eve$message (EVE$_NOSUCHFILE, 0, get_file_name);
	eve$learn_abort;
	return (FALSE);
    [TPU$_PARSEFAIL]:
	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(FALSE);
    [OTHERWISE]:
endon_error;

if eve$check_bad_window
then
    eve$message (EVE$_CURSINTEXT);
    eve$learn_abort;
    return (FALSE);
endif;

if (get_file_parameter = eve$kt_null) then
	get_file_name := read_line("File to get: ");
else
	get_file_name := get_file_parameter;
endif;
!!!!!!!!!! MOD for search DCL buffer for filename  !!!!!!!!!
if (get_file_name = eve$kt_null) then
	eve$rtp_interactive_get_file(get_file_name);
	! couldn't get  a filename from user select or remove
	! or user did a set default
	if (get_file_name = eve$kt_null) 
	then 
		return;
	endif;
endif;	  ! end of null user entry


if ((file_parse(get_file_name,"","",NAME) = eve$kt_null) and 
    (eve$is_wildcard(get_file_name) = FALSE))
then	! assume user wants to do a set default
	temp_file_name := call_user(rtp$calluser_set_default,get_file_name);
	delete(eve$x_dcl_process); !get rid of subproc pointing to old default
	message(fao("Set default to : !AS",get_file_name));
	return;
endif;
! Protect against earlier file_search with same file name.
eve$reset_file_search;
temp_file_name := eve$kt_null;
erase (eve$choice_buffer);
file_count := 0;
loop	!see if file exists 
    file_search_result := file_search (get_file_name);
    exitif file_search_result = eve$kt_null;
    file_count := file_count + 1;
    eve$add_choice (file_search_result);
    temp_file_name := file_search_result;
endloop;

if file_count > 1 then

    ! If get_file is called from eve$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),"eve_get_file");
    update(current_window);
    return;
endif;
! Set-up to see if we already have a buffer by that name

if temp_file_name = eve$kt_null then
    temp_buffer_name :=
	file_parse (get_file_name, eve$kt_null, eve$kt_null, name) +
	file_parse (get_file_name, eve$kt_null, eve$kt_null, type);
else
    temp_buffer_name :=
	file_parse (temp_file_name, eve$kt_null, eve$kt_null, name) +
	file_parse (temp_file_name, eve$kt_null, eve$kt_null, type);
endif;
get_file_name := file_parse (get_file_name);
          
! Make sure we don't try to use a wildcard file-spec to create a new file.

if file_count = 0 then

    if eve$is_wildcard (get_file_name) then
	message(fao("No files matching: !AS", get_file_name));
	if eve$x_starting_up then
	    eve$set_status_line (current_window);
	endif;
	return;
    endif;

endif;

loop_buffer := get_info (buffers, eve$kt_first);
loop
    exitif loop_buffer = 0;
    if temp_buffer_name = get_info (loop_buffer, eve$kt_name) then
	found_a_buffer := 1;
	exitif 1;
    endif;
    loop_buffer := get_info (buffers, "next");
endloop;

! If there is a buffer by that name, is it the exact same file?
! If so, switch to that buffer.  Otherwise use a new buffer,
! asking for a new buffer name (null new name will abort).

if found_a_buffer then			! Have a buffer with the same name

    if temp_file_name = eve$kt_null then	! No file on disk
	if get_file_name = get_info (loop_buffer, eve$kt_output_file) then
	    want_new_buffer := 0;
	else
	    want_new_buffer := 1;
	endif;
    else				! Check to see if the same file
	if (temp_file_name = get_info (loop_buffer, eve$kt_output_file)) or
	   (temp_file_name = get_info (loop_buffer, eve$kt_file_name)) then
	    want_new_buffer := 0;
	else
	    want_new_buffer := 1;
	endif;

    endif;

    if want_new_buffer then
	message (fao ("Buffer name !AS is in use", temp_buffer_name));
	temp_buffer_name :=
	    read_line ("Type a new buffer name or press Return to cancel: ");
	if temp_buffer_name = eve$kt_null then
	    message ("No new buffer created");
	else
	    new_buffer := eve$create_buffer
			      (temp_buffer_name, get_file_name, temp_file_name);
	endif;
    else
	if current_buffer = loop_buffer then
	    message (fao ("Already editing file !AS", get_file_name));
	else
	    map (current_window, loop_buffer);
	endif;
    endif;

else			! No buffer with the same name, so create a new buffer
    new_buffer :=
	eve$create_buffer (temp_buffer_name, get_file_name, temp_file_name);
endif;

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;

! Procedure that returns a string which is the TYPE of the input parameter.

! This is primarily a debugging tool for those times when you 
! get unexpected results.

procedure rlb_type_name(variable_name)
local  var_name;
 	var_name := get_info(get_info(variable_name,"type"),"name");
return(var_name);
ENDPROCEDURE


! EVE$FILE.TPU 			23-OCT-1987 10:27			Page 13

! Procedure called by eve_get_file to create a new buffer and map it
! to the current window.  Returns the created buffer, or zero if error.
!
! Parameters:
!	buffer_name		Name of new buffer - input
!	requested_file_name	Full VMS filespec to use - input
!	actual_file_name	From file_search; "" if not on disk - input

procedure eve$create_buffer (buffer_name,	! Create a buffer
			     requested_file_name, actual_file_name)

local   new_buffer,		! Buffer created
	create_failed,
	default_exists;

on_error
    [TPU$_DUPBUFNAME]:
	eve$message (EVE$_BUFEXIST, 0, substr (buffer_name, 1,
					       eve$x_max_buffer_name_length));
	return (FALSE);
    [TPU$_OPENIN]:
	eve$message (error_text, error);
	create_failed := TRUE;
    [TPU$_TRUNCATE]:
	eve$message (error_text, error);
    [OTHERWISE]:
endon_error;

! default buffer not created until after end of startup
! (after /INIT processing in procedure TPU$INIT_POSTPROCEDURE)

default_exists := (get_info (eve$default_buffer, "type") = BUFFER);

if actual_file_name = ""
then
    if not default_exists		! i.e., during startup
    then
	new_buffer := create_buffer (buffer_name);
	set (LEFT_MARGIN, new_buffer, eve$x_default_left_margin, CHARACTERS);
	if get_info (COMMAND_LINE, "display")
	then
	    set (RIGHT_MARGIN, new_buffer,
		 (get_info (eve$main_window, "width", CHARACTERS) -
		  eve$x_default_right_margin),
		 CHARACTERS);
	    set (RIGHT_MARGIN_ACTION, new_buffer, eve$kt_word_wrap_routine);
	endif;
    else
	new_buffer := create_buffer (buffer_name, "", eve$default_buffer);
	set (MODIFIABLE, new_buffer, ON);	! override default buffer
	set (NO_WRITE, new_buffer, OFF);	! override default buffer
    endif;
    if create_failed
    then
	delete (new_buffer);
	return (FALSE);
    endif;
    eve$message (EVE$_FILENOTFOUND, 0, requested_file_name);
    set (OUTPUT_FILE, new_buffer, requested_file_name);
else
    if not default_exists
    then
	new_buffer := create_buffer (buffer_name, actual_file_name);
	set (LEFT_MARGIN, new_buffer, eve$x_default_left_margin, CHARACTERS);
	if get_info (COMMAND_LINE, "display")
	then
	    set (RIGHT_MARGIN, new_buffer,
		 (get_info (eve$main_window, "width", CHARACTERS) -
		  eve$x_default_right_margin),
		 CHARACTERS);
	    set (RIGHT_MARGIN_ACTION, new_buffer, eve$kt_word_wrap_routine);
	endif;
    else
	new_buffer := create_buffer (buffer_name, actual_file_name,
				     eve$default_buffer);
	set (MODIFIABLE, new_buffer, ON);	! override default buffer
	set (NO_WRITE, new_buffer, OFF);	! override default buffer
    endif;
    if create_failed
    then
	delete (new_buffer);
	return (FALSE);
    endif;
    if eve$x_starting_up and get_info(command_line,"output") then 
    	set (OUTPUT_FILE, new_buffer, get_info(command_line,"output_file"));
    else
    	set (OUTPUT_FILE, new_buffer, actual_file_name);
    endif;
endif;

if not default_exists
then
    set (EOB_TEXT, new_buffer, message_text (EVE$_EOBTEXT, 1));
    set (LEFT_MARGIN, new_buffer, eve$x_default_left_margin, CHARACTERS);
    set (RIGHT_MARGIN, new_buffer,
	 (get_info (current_window, "width", CHARACTERS) -
	  eve$x_default_right_margin),
	 CHARACTERS);
    set (RIGHT_MARGIN_ACTION, new_buffer, eve$kt_word_wrap_routine);
endif;

map (current_window, new_buffer);

return (new_buffer);

endprocedure;

procedure eve$reset_file_search		! Null out file_search context

local   temp_string;

on_error	! this prevents error message if no default directory
    [TPU$_PARSEFAIL]:
    [OTHERWISE]:
endon_error;

! trashes out if you are set default to a dir. in a search list and you
! give the following call : x := file_search("")
temp_string := file_search ("sys$login:");

endprocedure;