MODULE TPUPlus_PRNT IDENT "900409"
!
! TPUPlus print utilities module
!
! EVE utility procedures
!
!   PROCEDURE EVE$PRINT_RANGE (RANGE_TO_PRINT, BRIEF_MESSAGE)
!
!   PROCEDURE EVE_PRINT_BUFFER
!   PROCEDURE EVE_PRINT_FILE (FILE_TO_PRINT)
!   PROCEDURE EVE_PRINT_FF
!   PROCEDURE EVE_PRINT_RANGE
!   PROCEDURE EVE_PRINT_SCREEN
!   PROCEDURE EVE_PRINT_SELECT
!
!   PROCEDURE PCE$PRINT_RANGE
!

!****************************************
PROCEDURE EVE$PRINT_RANGE (RANGE_TO_PRINT, BRIEF_MESSAGE)
!
! Procedure to print a range.  Accepts the range as input
!
local   v_pos;

v_pos := mark (none);
set (text, message_window, no_translate);
update (message_window);            ! This extra statement req'd (V5.3)
message (ascii(27) + '[5i');        !Turn on printer controller mode
update (message_window);
if (brief_message <> "") then
    message (brief_message);
    update (message_window);
endif;
position (beginning_of (range_to_print));
!
! Print the range.  Note that we have to do carriage control ourselves
!
loop
    exitif (mark (none) >= end_of (range_to_print));
    message (current_line);         ! Write line to printer
    update (message_window);        ! Make sure it gets out
    message (ascii (13) + ascii (10)); ! Write crlf
    update (message_window);
    move_vertical (1);            !Next line in range
endloop;
message (ascii(27) + '[4i');        !Turn off printer controller mode
update (message_window);
set (text, message_window, blank_tabs); ! Put back the window the way it was
erase (tpu$x_message_buffer);
position (v_pos);

ENDPROCEDURE;

!****************************************
PROCEDURE EVE_PRINT_BUFFER

! Procedure to print the current buffer.

!
! This procedure writes the current buffer, doing no translation of
! control/escape characters. It then submits the file to the specified print
! que (default SYS$PRINT).
!

local   this_position,
        this_buffer, 
        buffer_name, 
        file_name, 
        print_command, 
        print_process;

on_error
    if error = TPU$_createfail then
        message ("Subprocess could not be created");
        set (timer, on, "Executing...");
        return;
    endif;
endon_error;

set (informational,off);
set (success,off);
set (timer, off);
this_position   := mark (none);
this_buffer     := current_buffer;

!eve$search_controls (this_buffer);        ! Translate control characters.

buffer_name := get_info (this_buffer, "name");
file_name   := get_info (this_buffer, "file_name");
if file_name = "" then
    file_name := read_line (fao
        ("Enter a file name to write buffer !AS or press RETURN to cancel: ",
        buffer_name));
    if file_name = "" then
        set (informational, on);
        set (success, on);
        return;
    endif;
endif;

if (index (file_name, ";") <> 0) then
    file_name := substr (file_name, 1, index (file_name, ";") - 1);
endif;

eve_write_file (buffer_name);
! Set the output file on the original buffer. Consistent with eve_write_file.
set (output_file, this_buffer, file_name);
print_command := read_line ("Print command: ");
if print_command = "" then
    print_command := "PRINT/NOFEED";
endif;
print_command := print_command + " ";
message (fao ("Printing !AS with command !AS", file_name, print_command));
print_process := create_process (tpu$x_message_buffer, "$set noon");
send (print_command + file_name, print_process);

delete (print_process);
set (informational, on);
set (success, on);
set (timer, on, "Executing...");
update (message_window);

position (this_position);

ENDPROCEDURE;

!****************************************
PROCEDURE EVE_PRINT_FILE (FILE_TO_PRINT)
!
! EVE PRINT FILE command.  Accepts a file name, and prints the
! file on the printer port.
!
local print_file, v_pos, v_file, v_header;

on_error
    position (v_pos);
    return;
endon_error;

v_pos := mark (none);
if eve$prompt_string (file_to_print, print_file,
        "File to print: ", "No file printed") then
    position (eve$choice_buffer);
    erase (current_buffer);
    v_file := read_file (print_file);
    message ("");
    v_header := fao ("[!AS !%D]!/!/", v_file, 0);
    eve$print_range (create_range (beginning_of (current_buffer),
        end_of (current_buffer), none), v_header);
    erase (current_buffer);
    position (v_pos);
endif;
ENDPROCEDURE;

!****************************************
PROCEDURE EVE_PRINT_FF
!
! Procedure to print a form feed on the printer port
!
set (text, message_window, no_translate);
update (message_window);                ! This extra statement req'd (V5.3)
message (ascii(27) + '[5i' + ascii(12) + ascii(27) + '[4i');
update (message_window);
set (text, message_window, blank_tabs); ! Put back the window the way it was
erase (tpu$x_message_buffer);
refresh;

ENDPROCEDURE;

!****************************************
PROCEDURE EVE_PRINT_RANGE

!
! EVE command to print a range, or the whole buffer if
! there is no select active.  Does not clear the select range
!
local v_range, v_line, v_pos;

set (timer, off);

v_pos := mark (none);
if (eve$x_select_position = 0) then
    v_range := create_range (beginning_of (current_buffer),
                   end_of (current_buffer), none);
else
    v_range := create_range (eve$x_select_position, mark (none), none);
endif;
eve$print_range (v_range, "");

set (timer, on, "Executing...");

ENDPROCEDURE;

!****************************************
PROCEDURE EVE_PRINT_SCREEN

set (timer, off);
set (text, message_window, no_translate);
update (message_window);                ! This extra statement req'd (V5.3)
message (ascii (27) + '[i');
update (message_window);
set (text, message_window, blank_tabs); ! Put back the window the way it was
erase (tpu$x_message_buffer);

set (timer, on, "Executing...");

ENDPROCEDURE;

!****************************************
PROCEDURE EVE_PRINT_SELECT

!
! EVE command to print a range.
!

local v_range, v_line, v_pos;

v_pos := mark (none);
if (eve$x_select_position = 0) then
    message ("No select range active -- print cancelled");
!    v_range := create_range (beginning_of (current_buffer),
!                   end_of (current_buffer), none);
else
    v_range := create_range (eve$x_select_position, mark (none), none);
    pce$print_range (v_range);
    eve$x_select_position := 0;
endif;

if eag_map_lock = 1 then
    eag_show_map;
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE PCE$PRINT_RANGE (RANGE_TO_PRINT)

!
! This procedure writes the current buffer, doing no translation of
! control/escape characters. It then submits the file to the specified print
! que (default SYS$PRINT).
!

local   this_position,
        this_buffer, 
        tmp_buffer,
        tmp_buffer_name,
        tmp_file_name,
        buffer_name, 
        file_name, 
        print_command, 
        print_process;

on_error
    if error = TPU$_createfail then
         message ("Subprocess could not be created");
         return;
    endif;
endon_error;

set (informational,off);
set (success,off);
set (screen_update, off);

this_position   := mark (none);
this_buffer     := current_buffer;
buffer_name     := get_info (this_buffer, "name");
file_name       := get_info (this_buffer, "file_name");
print_command   := read_line ("Print command: ");
if print_command = "" then
    print_command := "PRINT/DELETE/NOFEED ";
else
    print_command := print_command + "/DELETE ";
endif;

if file_name = "" then
    tmp_file_name   := "EVE_PRINT_" + buffer_name + ".TMP";
endif;
if (index (file_name, ";") <> 0) then
    if (index (file_name, "]") <> 0) then
        file_name   := substr (file_name, index (file_name, "]") + 1,
            length (file_name));
    endif;
    file_name       := substr (file_name, 1, index (file_name, ".") - 1);
    tmp_file_name   := "EVE_PRINT_" + file_name + ".TMP";
endif;

eve_buffer ("temp");
tmp_buffer      := current_buffer;
tmp_buffer_name := get_info (tmp_buffer, "name");
copy_text (range_to_print);
eve_write_file (tmp_file_name);
eve_set_nowrite;

! Set the output file on the original buffer. Consistent with eve_write_file.
set (output_file, this_buffer, file_name);
message (fao ("Printing !AS with command !AS", file_name, print_command));
print_process := create_process (message_buffer, "$set noon");
send (print_command + tmp_file_name, print_process);

eve_buffer (buffer_name);
delete (tmp_buffer);
delete (print_process);

set (informational, on);
set (success, on);
set (screen_update, on);

eve$position_in_middle (eve$x_select_position);

ENDPROCEDURE;

! procedure arguments
eve$arg1_print_file     := "string";

ENDMODULE;