!
!
! ***** PRINT_BUFFER *****
!
! The 3 following procedures copy the current buffer to another buffer,
! translate control characters to readable characters and write the
! new buffer. It then submits the file to the specified print queue (default
! SYS$PRINT). 
!
! This procedure calls the other two and creates sends the print command
! to the DCL subprocess to print the file.
!
!   buf_to_print:  Buffer variable pointing to buffer to print.
!
PROCEDURE fred$print_buffer(buf_to_print)
   LOCAL write_result,
	temp,	      		! Save passed filename
	this_position,
	this_buffer,
	buffer_name,
	file_name,
	print_command,
	print_process,
	buffer_to_print,
	ans;

   SET (informational,off);
   SET (success,off);
   this_position := MARK (none);
   this_buffer := CURRENT_BUFFER;
                 
   buffer_to_print := buf_to_print;
   if (buffer_to_print = 0) then
      ans := READ_LINE ("Buffer to print [" +
			GET_INFO (this_buffer,"name") + "]: ");
      if ans = eve$kt_null then
	 buffer_to_print := this_buffer;
      else
	 buffer_to_print := decus$find_buffer (ans);
	 if buffer_to_print = 0 then
	    MESSAGE ("No such buffer ... " + ans);
	    RETURN;
	 endif;
      endif;
   endif;

   POSITION (show_buffer);
   ERASE (show_buffer);
   COPY_TEXT (buffer_to_print);
   fred$translate_controls (show_buffer);	! Translate control characters.
   POSITION (buffer_to_print);

   if eve$x_trimming then                                       
      eve$trim_buffer (show_buffer);
   endif;           

   temp := GET_INFO (buffer_to_print,"output_file");

   if temp = 0 then
      temp := FILE_PARSE (GET_INFO (buffer_to_print,"name"),".LIS");
   else
      temp := FILE_PARSE (SUBSTR (temp,1,INDEX (temp,";")),".LIS");
   endif;
       
   write_result := WRITE_FILE (show_buffer, temp);
                                        
   print_command := "PRINT/NOTIFY/DELETE ";
   fred$hidden_subprocess (print_command + write_result);
   MESSAGE (FAO ("Printing !AS with command !AS.",write_result,print_command));

   SET (informational,on);
   SET (success,on);
   UPDATE (message_window);

   POSITION (this_position);

ENDPROCEDURE;


! This procedure translates all of the control characters 
! in the specified buffer.
!
PROCEDURE fred$translate_controls (this_buffer)
   LOCAL control_char_pat,
	control_char;

! When the search fails we know that we have either hit the end of
! the buffer or there were no more special characters found.
   on_error
      POSITION (BEGINNING_OF (this_buffer));
      RETURN;                     
   endon_error;

   control_char_pat := ANY (' ');

   POSITION (BEGINNING_OF (this_buffer));
   loop							! Find all occurrences
      control_char := SEARCH (control_char_pat, forward);
      exitif control_char = 0;
      POSITION (control_char);
      decus$translate_controls (CURRENT_CHARACTER);	! Substitute the new text
      ERASE (control_char);				! then erase it
   endloop;

ENDPROCEDURE;


PROCEDURE fred$print_range
   LOCAL write_result;
                
   write_result := decus$write_range;
   if write_result <> eve$kt_null then 
      print_command := "PRINT/NOTIFY/DELETE ";
      fred$hidden_subprocess (print_command + write_result);
      MESSAGE (FAO ("Printing !AS with command !AS.",write_result,print_command));
   else
      MESSAGE ("Nothing to print ... PASTE buffer is empty...");
   endif;
   
ENDPROCEDURE;


PROCEDURE decus$write_range
   LOCAL listname,
	 write_result;

   if BEGINNING_OF (paste_buffer) <> END_OF (paste_buffer) then
      listname := READ_LINE ("Output filename of PASTE buffer [PASTE.LIS]: ");
      if (listname = eve$kt_null) and (LAST_KEY = RET_KEY) then
	 listname := "PASTE.LIS";
	 if LAST_KEY = CTRL_Z_KEY then
	    MESSAGE ("Nothing written out...");
            RETURN ("");
         endif;
      endif;
      
      write_result := WRITE_FILE (paste_buffer, listname);
                      
!      ERASE (paste_buffer);
!    use insist y or n to get an answer for erasing the paste buffer....???

      RETURN (write_result);
   else
      MESSAGE ("Nothing to output...PASTE buffer is empty...");
      RETURN ("");
   endif;
                      
ENDPROCEDURE;