!Last Modified:  15-JUN-1989 11:28:46.60, By: FLEMING 
procedure eve_subprocess_module_init
	eve$x_dcl_process := 0;
endprocedure;
! (Captain) Hook procedure for calling other packages. Parameter specifies name
! of package. This routine spawns to the appropiate DCL routine, after
! writing out the current buffer. After returning from the spawn the file
! which has the same buffername is read in so as to obtain the updated
! copy.
procedure eve_hook(func_name)
local this_file,this_command,that_file,write_result,local_func;
	
	local_func := func_name; ! transfer else edit doesn't work for string
	edit(local_func,UPPER);
	edit(local_func,TRIM);
	message(local_func);
	! if not a reconized hook then return
	if (local_func <> "LSE") and (local_func <> "SPELL") then
		message ("Unreconized hook");
		return;
	endif;
	this_file := get_info(current_buffer,"name");
	write_result := write_file(current_buffer);! write out buffer
	set(output_file,current_buffer,write_result);
	! command = disk:[device]eve_hookname  buffer_filename
	this_command := "@util_root:[eveplus]"+"eve"+local_func+"  "+
		write_result;
	eve_dcl(this_command); ! do the dcl with the command
	eve_destroy_buffer(this_file); ! destroy the current buffer
	write_result := file_parse(';0',write_result);
	eve_get_file(write_result); ! get the file
	eve_refresh; ! refresh the screen
endprocedure

! Hook into LSE
procedure eve_lse
	eve_hook("lse");
endprocedure

! Hook into Spell checker
procedure eve_spell
	eve_hook("spell");
endprocedure


!									Page 93
! Spawn a new DCL subprocess and go to that subprocess.  Logging out of
! the subprocess will resume the Eve session.  Useful for running
! screen-oriented programs that can't go through VMS mailboxes.

procedure eve_spawn

on_error
    if error = tpu$_createfail then
	message ("DCL subprocess could not be created");
	return;
    endif;
endon_error;

message (eve$kt_null);		! Clear out old message
spawn;

endprocedure


procedure eve_spawn_mail
	
	spawn("mail");
endprocedure


! eve_mailx:  send mail from a buffer
!   possible enhancements would be to allow a select range from a buffer
!   after selecting the buffer
!
!Last Modified:  11-AUG-1988 21:10:57.67, By: FLEMING      

! global variables:  eve$x_dcl_process -- ptr to subprocess for MAIL sending
!		     
! EVE_CREATE_MAIL_PROCESS can be called from 2 pts in EVE_MAILX or JPI_INFO
!

Procedure eve_create_mail_process
local mail_message_buffer,
	this_window,
	dcl_window,
	this_position,		! Marker for current cursor position
	input_buffer;		! Current buffer
on_error
    [tpu$_createfail] :
	message ("DCL subprocess could not be created");
	return (0);
    [OTHERWISE] : 
	message(fao("EVE_CREATE_MAIL_PROCESS, !AS on line: !SL",
			error_text,error_line));
  	return(0);
endon_error;

! see if the message buffer already exists

	mail_message_buffer := eve$find_buffer("DCL"); 
	if mail_message_buffer = 0 then 
		message("Creating DCL buffer");
		eve$dcl_buffer := eve$init_buffer("DCL","")
	endif;                                    

	if get_info(eve$dcl_buffer,"type") <> buffer then
		message("EVE$DCL_BUFFER is not a BUFFER"); endif;

	if (get_info (eve$x_dcl_process, "type") = unspecified) or
	   (get_info (eve$dcl_buffer,"type") = unspecified) or
	   (eve$x_dcl_process = 0) then
	    message ("Creating DCL subprocess...");
	    eve$x_dcl_process := create_process (eve$dcl_buffer, "$ set noon");
	endif;


	input_buffer := current_buffer;
	this_position := mark (none);
	if input_buffer <> eve$dcl_buffer then
	    if eve$x_number_of_windows >= 2 then
		this_window := current_window;
		dcl_window := eve$get_mapped_window (eve$dcl_buffer);
		if dcl_window = 0
		  then
	    ! insure the dcl_window is opposite the current_window
		  dcl_window := eve$bottom_window;
	    	  if dcl_window = this_window
	    		then
			dcl_window := eve$top_window;
	    	  endif;
		endif;
		if current_buffer <> eve$dcl_buffer then
		    map (dcl_window, eve$dcl_buffer);
		    set (STATUS_LINE, dcl_window, REVERSE, 
			message_text (EVE$_DCLSTATUS, 1));
		endif;
	    endif;
	endif;

	position (end_of (eve$dcl_buffer));
	send('$ mail = ""',eve$x_dcl_process);
	send('$ save_mess = f$environment("MESSAGE")',eve$x_dcl_process);
	send('$ set message/nofac/noid/nosev/notext',eve$x_dcl_process);
	send('$ mail = ""',eve$x_dcl_process);
	send('$ if f$trnlnm("sys$input","lnm$process","SUPERVISOR").nes."" '+
		' then $ deassign/process sys$input',eve$x_dcl_process);
	send("$ set mess'save_mess'",eve$x_dcl_process);

	position (end_of (eve$dcl_buffer));

	if get_info(this_window,"type") = WINDOW then 
		update (this_window);	endif;

	if (eve$x_number_of_windows > 1) and (input_buffer <> eve$dcl_buffer)
		then  eve_other_window; endif;
	return (1);
endprocedure;
!*** revised to leave unmodified buffer alone if it already has a mod date
!*** and not to put in blank line if the insert is done at the end of the
!*** buffer
!
! this procedure modifies or inserts a comment that marks the current
! date and time as the last date modified when writing out a file from TPU
!
!*****

procedure eve_update_mod_date(;input_buffer)

Local	work_buffer,
	RLB_DATE_PAT,
	user_test_pat,
	end_pat,
	EVE$X_DATE_TIME_PAT,
	date_range,
	UPDATE_FLAG,
	file_type,	! what type of file is it?
	date_string,	! when it's being updated
	upd_pat,	! search pattern for locating the date
	comment_begin, comment_end, Mod_string,
	insert_pos, mod_start, 
	update_pos, update_user, upd_range,
	save_position, out_name, 
	user_begin, user_end,
	comment_logical,
	date_time, blank_or_null ;
on_error
  message(fao('EVE_UPDATE_MOD_DATE, !AS on line: !SL',error_text,error_line));
endon_error;

save_position := mark(none);
if get_info(input_buffer,"type") = UNSPECIFIED then 
		work_buffer := current_buffer;	
	else	work_buffer := input_buffer;	endif;

update(current_window);
position(beginning_of(work_buffer));
update_flag := true;
file_type := substr(file_parse(eve_output_file_name(work_buffer),
			'','',type),2,39);
! set up the default conditions
insert_pos := beginning_of(work_buffer);
mod_string := 'Last Modified:  ';
comment_end := '';
! see what file type it is
if (	(file_type = 'C') or
	(file_type = 'RPL')
  )	then comment_begin := '/*'; comment_end := '*/';
else
if file_type = 'COM' then 

! see if it is a DCL command procedure or a console procedure.

		if search_quietly("deposit",forward,no_exact) <> 0 then
! it is a console procedure
			comment_begin := "!" 
! it is a DCL procedure
		else	comment_begin := '$!'; endif;
		insert_pos := end_of(work_buffer);
else
if file_type = 'FOR' then comment_begin := 'C ';
else
if (file_type = 'MSS') or (file_type = 'MAK') 	
	then comment_begin := '@Comment['; comment_end := ']';
		mod_string := 'LastEditDate=';
else
if file_type = 'MAR' then comment_begin := ';';
else
if file_type = 'PAS' then comment_begin := '{'; comment_end := '}';
else
if file_type = 'RNO' then comment_begin := '.;';
else
if(	(file_type = 'TPU') or (file_type = 'EVE') or
	(file_type = 'CLD') or
	(file_type = 'DIS') or
	(file_type = 'HLP') or
	(file_type = 'MMS')
	)	 then comment_begin := '!';
else if file_type = 'CMD' then comment_begin := ";" 
else 
	update_flag := false;
	position(save_position);
 	return; 
	endif;
endif; endif; 
endif; endif;
endif; endif;
endif; endif;

! get the username via hook or crook

if get_info(eve$x_username,'type')<>string then
	eve$x_username := call_user(rtp$calluser_getjpi,'USERNAME'); 
	edit(eve$x_username,"TRIM");
endif;

  blank_or_null :=  span(' 	') | '' ;

! build the search pattern
!  This pattern will match either of 2 date formats
!
rlb_date_pat := 
	( ( eve$x_span_digits+'-'+eve$x_span_alpha+'-'+eve$x_span_digits ) |
	(eve$x_span_digits+'/'+eve$x_span_digits+'/'+eve$x_span_digits ) )
	@date_range ;

!
! This pattern matches the date&time portion
!
  eve$x_date_time_pat :=
	rlb_date_pat @date_time
	+ ( span('	 :') @date_time
	+ ( eve$x_span_digits +
	( (':'+eve$x_span_digits @date_time +
	   ( (':'+eve$x_span_digits @date_time +
	      ( ('.'+eve$x_span_digits @date_time
	      ) | '' )
	    ) | '' )
	) | '' ) )
	) ;

! Pattern to match & parse the "last date modified" comment
! the "@variable" stores the range that is matched to the point
! in the pattern where it is found.

if comment_end = eve$kt_null then
	end_pat := line_end;
  else	end_pat := ( match( comment_end) | line_end ) ;
  endif;

upd_pat := line_begin &  match(comment_begin)
		& match(mod_string) @mod_start
		& eve$x_date_time_pat @user_begin 
		& end_pat;

date_string := fao('!%D',0);
date_time := 0; user_begin := 0;
! it could be anywhere so start from the top
position(beginning_of(work_buffer));
! search for the comment 
update_pos := search_quietly(upd_pat,forward,no_exact);
! Is there already one of these lines?
if ( mod_start = 0 ) or ( date_time = 0 ) then
! since there isn't one yet, insert one

	
	position(insert_pos);
	mod_start := mark(none);
	copy_text(comment_begin+mod_string+date_string+
		  ', By: '+eve$x_username+' '+comment_end);
	if mod_start <> end_of(current_buffer) then split_line; endif;

! see if it's really been modified.  If not leave it alone.

! substitute the new date

ELSE if get_info(current_buffer,'modified') then
	position(end_of(mod_start));  Move_horizontal(1);
	position(end_of(mod_start)); 
	move_horizontal(1);	
	mod_start := mark(none);	
	upd_range:=create_range(mod_start,end_of(date_time),none);	
	erase(upd_range);
	copy_text(date_string);	
	position(end_of(user_begin));	

	user_test_pat := 'By:' & blank_or_null @user_begin  &
		span(eve$x_symbol_characters) @user_end & blank_or_null;

	if comment_end = eve$kt_null then 
		user_test_pat := user_test_pat & line_end ;
	else	user_test_pat := user_test_pat & ( comment_end | line_end ) ;
	endif;

	update_pos  := search_quietly(user_test_pat,forward,exact);

	if (update_pos<>0) then

	 position(end_of(user_begin)); move_horizontal(1);
	 mod_start := mark(none);
	 upd_range:=create_range(mod_start,end_of(user_end),none);
	 erase(upd_range);
	 copy_text(eve$x_username);
	else

	 copy_text(', By: '+eve$x_username+' ');
	endif;

endif; endif;

position(save_position);
update(current_window);
endprocedure;
!Last Modified:  11-AUG-1988 21:34:46.04, By: RLB 

! Highlite a specified range and display the supplied name if any

procedure highlite_range(;high_range,range_name)

local tmp_range, work_range;

if get_info(high_range,"TYPE") = UNSPECIFIED then
	work_range := get_info(current_buffer,"first_range");
	if work_range = 0 then return(TPU$_INVRANGE); 
	else range_name := "FIRST RANGE in " + get_info(current_buffer,"name");
	endif;
 else	work_range := high_range; endif;

if work_range = 0 then 
	message("Your range for !AS is = 0",0,range_name);
else
	tmp_range := create_range(beginning_of(work_range),
			end_of(work_range),reverse);
	if get_info(range_name,"type") = STRING then 
		message("Range !AS",0,range_name); endif;
	update(current_window);
	sleep(2);
	delete(tmp_range);
endif;
endprocedure;

! convert a HEX string to internal integer 
procedure hex_to_int(in_string)
hex_to_int := int(in_string,16);
endprocedure

Procedure rlb_return_to_main
local	master_process,
	owner_process, 
	my_process,
	new_edit_file, 
	new_buffer_name, 
	edit_new_buffer;
on_error
! If the new file parse fails -- there is no new file to bring in
	if error = tpu$_parsefail 
	then 
		return; 
	endif
endon_error
  master_process := call_user(rtp$calluser_getjpi,"MASTER_PID");
  edit(master_process,trim,compress);
  master_process := int(master_process,16);
  owner_process := call_user(rtp$calluser_getjpi,"OWNER");
  edit(owner_process,trim,compress);
  owner_process := int(owner_process,16);
  my_process := call_user(rtp$calluser_getjpi,"PID");
  edit(my_process,trim,compress);
  my_process := int(my_process,16);

  !  Is there somewhere to attach to ?  If MASTER = PID then we are the root
  !  and you can't attach to yourself.

  if master_process <> my_process then

  !  Attach to the root process -- other option would be to attach to the
  !  Owner process.  This is a design preference -- could go either way.

	attach(master_process);

	! on return see if there is a new file to open -- if there isn't
	! there will be a parse failure.  That's the reason for the ON_ERROR
	! EDIT_NEW_FILE is a logical name defined by KEPT_EDIT.COM if the
	! procedure was invoked with a non-null parameter that translated
	! successfully to a file name.

	edit_new_file := file_parse("EDIT_NEW_FILE:");

	! see if there is a new file to edit -- if so then bring it in

	if edit_new_file <> eve$kt_null then 
		if (file_parse(edit_new_file,"","",name) <> eve$kt_null)
		and (file_parse(edit_new_file,"","",type) <> ".")
		then	! first parse can return [dirspec],;
			eve_get_file(edit_new_file); 
		endif
	endif;

	!  Change the default if it has changed in the parent.
	!  This is signalled via the EDIT_NEW_DEFAULT logical name.
	!  The logical name is defined by the KEPT_EDIT.COM procedure.

	if file_parse("")<>file_parse("edit_new_default:") then
		eve_get_file(file_parse("edit_new_default:")-".;"); ! set default
	endif;

	! now go back to the user
  else
	message('No parent to attach to');
  endif;
endprocedure