!===============================================================================
!	FRED - Extensions to EVE
!
!
!	This is a collection of TPU procedures to aid in building custom
!	section files (formerly EVE Plus from DECUS).
!
!	It defines a few basic building blocks and three procedures 
!	comprising an "include" feature and then executes a buffer which 
!	includes the various pacakages that make up "FRED". The three 
!	procedures are used thusly:
!
!	fred$start_build;		! Set-up to gather TPU$LOCAL_INITs
!	
!	fred$include("...");		! Include the first file
!	fred$include("...");		! Include the next file
!		:
!	fred$include("...");		! Include the last file
!
!	fred$complete_build;		! Compile the accumulated local init
!
! *** NOTE ***: The contents of this file has been modified for exclusive 
! 			use by FRED.
!===============================================================================
PROCEDURE fred$start_build			! Make init buffer & check environment
   LOCAL old_buffer;				! Buffer when we entered

   old_buffer := CURRENT_BUFFER;		! Remember where we were
   eve_buffer ("messages");
   UPDATE (CURRENT_WINDOW);
   fred$local_init := CREATE_BUFFER ("fred$local_init");
   SET (no_write, fred$local_init);		! Create an RO buffer

   fred$local_init_name := "tpu$local_init";
                                                   
   POSITION (fred$local_init);		! Put in our minimal local_init
   COPY_TEXT ("PROCEDURE ");			!  procedure 
   COPY_TEXT (fred$local_init_name);	       	!
   SPLIT_LINE;					!
   COPY_TEXT ("   fred$x_building := FALSE;");
   SPLIT_LINE;
   COPY_TEXT ("ENDPROCEDURE;");				
   SPLIT_LINE;
    
   fred$x_building := TRUE;
   POSITION (old_buffer);		! Go back to original buffer...

ENDPROCEDURE;

PROCEDURE fred$include(file_name)	! Include a .TPU file
   LOCAL temp_buffer,			! Buffer to compile in
	compiled_code,			! The compiled code
	expanded_file,			! Full name after defaulting etc.
	master_file,			! Name of the file associated with
		   		  	!  the current buffer - for defaulting
	init_code,			! The tpu$local_init from this file
	old_buffer,			! Buffer when we were entered
	temp,				! Junk
	end_pattern,			! "ENDPROCEDURE" pattern
	white_space,			! White-space spanning pattern
	the_pattern;			! Pattern that matches the whole
					!    tpu$local_init procedure

   master_file := GET_INFO (CURRENT_BUFFER, "file_name");
   expanded_file := FILE_PARSE (file_name, ".TPU;", master_file);

   temp := FILE_SEARCH ("");			! Reset file_search
    
   if (FILE_SEARCH (expanded_file) = "") then	! Does it exist?
      MESSAGE (" ");
      MESSAGE ("Can't find: " + expanded_file);! Nope.
   else
      MESSAGE (" ");
      MESSAGE ("Including "+expanded_file);
      old_buffer := CURRENT_BUFFER;		! Remember where we were
      temp_buffer := CREATE_BUFFER (expanded_file, expanded_file);
      SET (no_write, temp_buffer);
      POSITION (temp_buffer);			! Go to the init buffer
      end_pattern := LINE_BEGIN &		! Build a pattern that'll match 
                       "ENDPROCEDURE";		!  a tpu$local_init definition
      white_space := " " + ASCII(9);	    	!  with the procedure and
      the_pattern := LINE_BEGIN &		!  endprocedure both at the 
                       "PROCEDURE" &		!  left margin.
                       SPANL (white_space) &
                       fred$local_init_name &
                       end_pattern;

      init_code := decus$search_quietly (the_pattern, 
                                    FORWARD);	! Find the init code
      if (init_code <> 0) then                	!    and copy it
         POSITION (fred$local_init);		!    to the init buffer
         SPLIT_LINE;				!  after a blank line.
         COPY_TEXT (init_code);
      endif;

      SET (informational, on);			! Compile the buffer
      compiled_code := COMPILE (temp_buffer);	!  (including the
!      if (compiled_code <> 0) then		!  tpu$local_init
!         EXECUTE (compiled_code);		!  procedure!)
!      endif;
!      EXECUTE (compiled_code);			! Execute initialization code
      SET (informational, off);

      POSITION (old_buffer);			! Go back and clean up
      ERASE (temp_buffer);
      DELETE (temp_buffer);
   endif;
   temp := FILE_SEARCH ("");			! Keep from affecting
    						!  other file_searches
ENDPROCEDURE;

!
!	Procedure to combine the collected TPU$LOCAL_INIT procedures and
!	compile them. 
!
!
PROCEDURE fred$complete_build		! Compile all the local inits
   LOCAL old_buffer,				! Buffer when we were entered
	proc_pattern,				! "procedure" pattern
	white_space,				! White-space spanning pattern
	the_junk,
	the_pattern;				! Pattern that matches the extra
						! endprocedure/procedure pairs
 
   old_buffer := CURRENT_BUFFER;		! Remember where we were
   white_space := " " + ASCII(9);		! Create a pattern to
   proc_pattern := LINE_BEGIN &	  		!  match an endprocedure
                    "PROCEDURE" &		!  followed by a
                    		       		!  procedure tpu$local_init
                    SPANL (white_space) &	! NOTE:
                    fred$local_init_name; 	!  Any lines between the
   the_pattern := LINE_BEGIN &			!  end of one procedure
                   "ENDPROCEDURE" &		!  and the beginning of
                   proc_pattern;		!  the next will go away

   POSITION (BEGINNING_OF (fred$local_init));
    
   loop						! Search and destroy
      the_junk := decus$search_quietly(the_pattern, 
                                   FORWARD);	!  the extraneous
      exitif (the_junk = 0);			!  statements
      ERASE (the_junk);
   endloop;

   POSITION (BEGINNING_OF (fred$local_init));
    
   loop					! Remove any blank lines
      the_junk := decus$search_quietly (LINE_END & LINE_END, forward);
      exitif (the_junk = 0);
      POSITION (BEGINNING_OF (the_junk));
      ERASE (the_junk);
      MOVE_HORIZONTAL (1);
      exitif (MARK (none) = END_OF (CURRENT_BUFFER));
      MOVE_HORIZONTAL (-1);
      SPLIT_LINE;
      MOVE_VERTICAL(-1);
   endloop;

   MESSAGE ("");
   MESSAGE ("Compiling complete TPU$LOCAL_INIT...");
   COMPILE (fred$local_init);		! And compile what's left.
   POSITION (old_buffer);   			! Go back
   WRITE_FILE (fred$local_init, "FRED_LIBRARY:FRED$LOCAL_INIT.DATA");
   MESSAGE ("");
   MESSAGE ("Updating FRED version...");
   fred$update_version;			! Set current version of FRED
   MESSAGE ("FRED version updated...");

   MESSAGE ("");
   MESSAGE ("Executing complete TPU$LOCAL_INIT...");
   EXECUTE (fred$local_init_name);		! Execute the local init
                  
ENDPROCEDURE;

!
!
! ***** DECUS$SEARCH_QUIETLY *****
!
PROCEDURE decus$search_quietly(target, dir)	! Search w/o "String not found" 

   on_error       
      RETURN (0);
   endon_error;

   RETURN (SEARCH (target, dir));

ENDPROCEDURE;