PDP-10 Archive: sources/edt/lprint.bli from BB-R775E-BM

Trailing-Edge - PDP-10 Archives - BB-R775E-BM - sources/edt/lprint.bli

There are 10 other files named lprint.bli in the archive. Click here to see a list.

 %TITLE 'LPRINT - PRINT line-mode command'
MODULE LPRINT (				! PRINT line-mode command
		IDENT = '3-004'			! File: LPRINT.BLI Edit: CJG3004
		) =
BEGIN
!
!			  COPYRIGHT (c) 1981, 1985 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!		ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:	EDT -- The DEC Standard Editor
!
! ABSTRACT:
!
!	This module is called to produce a file containing
!	a specified range of text in a special format.
!
! ENVIRONMENT:	Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: February 3, 1978
!
! MODIFIED BY:
!
! 1-001	- Original.  DJS 30-JAN-81.  This module was created by
!	extracting the routines PRINT and EDT$$PRNT_CMD  from EXEC.BLI.
! 1-002	- Regularize headers.  JBS 20-Mar-1981
! 1-003	- Use new message codes.  JBS 04-Aug-1981
! 1-004 - Convert to fileio for reads and writes. STS 15-Jan-1982
! 1-005 - Pass RHB address to callfio. STS 21-Jan-1982
! 1-006 - Don't pass descriptors to close file. STS 10-Feb-1982
! 1-007 - Pass file name to edt$$fiopn_err. STS 25-Feb-1982
! 1-008 - Add literals for callable EDT. STS 08-Mar-1982
! 1-009	- Avoid infinitely recursive calls to PRINT.  JBS 11-Mar-1982
! 1-010	- Print a message on CLOSE errors.  JBS 12-Apr-1982
! 1-011 - Check for CNTRL/C.  SMB 14-Apr-1982
! 1-012 - Move conversion to UPCASE for PDP-11's to FILEIO.  SMB 21-Apr-1982
! 1-013	- Set a flag if control C actually aborts something.  JBS 24-May-1982
! 1-014 - Remove reference to SET_FMTWRRUT.  SMB 11-Jun-1982
! 1-015 - Save buffer position and restore after print. STS 14-Jun-1982
! 1-016	- Pass default file name in RHB parameter.  JBS 15-Jun-1982
! 1-017	- Remove EDT$$OPN_FI, EDT$$WR_OFI and EDT$$CLS_FI external references:
!	   they are unused.  JBS 15-Jun-1982
! 1-018 - Stop the working message before second CTRL/C check.  SMB 22-Jun-1982
! 1-019 - Stop processing on bad select range.  SMB 01-Jul-1982
! 1-020 - Errors on select must be caught at a higher level.  SMB 02-Jul-1982
! 1-021 - Change print file message names.  SMB 13-Jul-1982
! 1-022 - Make EDT$$TST_EOB in line. STS 22-Sep-1982
! 1-023 - Make EDT$$RNG_POSFRST in line. STS 11-Oct-1982
! 1-024 - Reject lines starting with ESC. JBS 19-Oct-1982
! 1-025 - Don't use STR$COPY for puts. STS 10-nov-1982
! 3-001 - Remove VMS code and RHB code. CJG 19-Apr-1983
! 3-002 - Remove call to EDT$$CALLFIO. CJG 10-Jun-1983
! 3-003 - Change the way that filespecs are handled. CJG 23-Jun-1983
! 3-004 - Fix incorrect saving of original position. CJG 8-Jul-1983
!--

%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    PRINT,					! Format write routine for PRINT command
    EDT$$PRNT_CMD : NOVALUE;			! Process the PRINT command

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!

LITERAL
    MAX_LINES = 55;

EXTERNAL LITERAL
    EDT$K_PUT,
    EDT$K_CLOSE,
    EDT$K_CLOSE_DEL,
    EDT$K_WRITE_FILE,
    EDT$K_OPEN_OUTPUT_NOSEQ;

!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!
!	In the routine

%SBTTL 'PRINT - intercept formatted output'
ROUTINE PRINT (					! Intercept formatted output
    RECADDR, 					! Address of record
    RECLEN					! Length of record
    ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is made the format write routine when doing a PRINT
!	command.  Whenever the formatting routines are to output a record
!	this routine is called, which in turn writes the line to the file.
!
! FORMAL PARAMETERS:
!
!  RECADDR		Address of the record to write
!
!  RECLEN		Length of that record
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	Same as EDT$$WR_OFI
!
! SIDE EFFECTS:
!
!	Changes the formatted write routine to EDT$$TI_WRLN during
!	I/O, then restores it before returning.
!
!--

    BEGIN

    EXTERNAL ROUTINE
	EDT$FILEIO,
	EDT$$TI_WRLN;

    EXTERNAL
	CUR_BUF : REF TBCB_BLOCK,
	FMT_WRRUT,
	IO_VFCHD;

    LOCAL
	STATUS,
	LEN,
	ADDR,
	FILE_DESC : BLOCK [1];

    STRING_DESC (FILE_DESC, RECLEN, .RECADDR);

!+
! Just in case the I/O routines have an error and decide to
! print a message about it, set the format write routine
! back to EDT$$TI_WRLN for the duration of the I/O.
!-

    FMT_WRRUT = EDT$$TI_WRLN;

!+
! Reject any lines that start with ESC. This is because if we do a PRINT in
! CHANGE mode, EDT will try to put the text at the bottom of the screen, and
! will issue escape sequences to this effect. Since we don't want these
! escape sequences to go into the file, reject them.
!-

    IF ((CH$RCHAR (CH$PTR (.RECADDR,, BYTE_SIZE)) EQL ASC_K_ESC) AND .RECLEN NEQ 0) THEN
	STATUS = 1
    ELSE
	STATUS = EDT$FILEIO (EDT$K_PUT, EDT$K_WRITE_FILE, FILE_DESC);

!+
! Now restore this routine as the formatted write routine.
!-
    FMT_WRRUT = PRINT;

    RETURN (.STATUS);
    END;					! of routine PRINT

%SBTTL 'EDT$$PRNT_CMD	- PRINT line-mode command'

GLOBAL ROUTINE EDT$$PRNT_CMD			! PRINT line-mode command
	: NOVALUE =

!++
! FUNCTIONAL DESCRIPTION
!
!	Command processing for PRINT. First, attempt to open the file.
!	If it succeeds then set up the routine above as the formatted
!	write routine and process the range. A page skip is done after
!	55 lines or when the first character of a line is a form feed,
!	Whichever comes first.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	CUR_BUF
!	TI_WID
!	RNG_ORIGPOS
!	WK_LN
!	EXE_CURCMD
!
! IMPLICIT OUTPUTS:
!
!	CC_DONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	On exit from this routine, the formatting routine is set to EDT$$TI_WRLN.
!	While it is running, the formatting routine is usually in this routine.
!
!--

    BEGIN

    EXTERNAL ROUTINE
	EDT$$STOP_WKINGMSG,
	EDT$$CHK_CC,
	EDT$FILEIO,
	EDT$$OUT_FMTBUF,
	EDT$$FMT_MSG,
	EDT$$TI_WRLN,
	EDT$$NXT_LNRNG,
	EDT$$RNG_REPOS,
	EDT$$RD_CURLN,
	EDT$$FIOPN_ERR,
	EDT$$CNV_UPC,
	EDT$$TY_CURLN;

    EXTERNAL
	EXT_MOD,			! Are we in EXT mode
	FMT_WRRUT,			! Address of write routine
	WRT_NAM : BLOCK,		! Write file descriptor
	RNG_SAVPOS,
	FMT_CUR,
	FMT_BUF,
	CUR_BUF : REF TBCB_BLOCK,
	TI_WID,
	RNG_ORIGPOS : POS_BLOCK,
	EOB_LN,
	RNG_FRSTLN,
	WK_LN : REF LIN_BLOCK,
	EXE_CURCMD : REF NODE_BLOCK,	! Pointer to current command
	CC_DONE;			! Set to 1 if ^C aborted something

    MESSAGES ((NOFILSPC, PRIFILCRE, PRIFILCLO));

    LOCAL
	FORMAT_ROUTINE,			! Save format routine on entry
	COUNT,				! Number of lines on this page
	SAVE_BUF,
	SAVE_WIDTH,			! Save terminal width
	RAN : REF NODE_BLOCK,		! Address of range node for PRINT
	IFI;				! IFI of output file


    OWN
	WHOLERNG : NODE_BLOCK		! Default to WHOLE range
	    PRESET ([NODE_TYPE] = RANGE_NODE,
		    [RAN_TYPE] = RAN_WHOLE);

    RAN = .EXE_CURCMD [RANGE1];

!+
! Make sure there is a file spec.
!-

    IF (.EXE_CURCMD [FSPCLEN] EQL 0) THEN
	BEGIN
	EDT$$FMT_MSG (EDT$_NOFILSPC);
	RETURN;
	END;

!+
! If the range is null, then make it the whole buffer.
!-

    SAVE_BUF = .CUR_BUF;			! Save original address
    IF (.RAN EQL 0) THEN RAN = WHOLERNG;
    IF (.RAN [RAN_TYPE] EQL RAN_NULL) THEN RAN [RAN_TYPE] = RAN_WHOLE;

!+
! Position to top of range.
!-

    RNG_FRSTLN = 1;
    EDT$$CPY_MEM (POS_SIZE, .CUR_BUF, RNG_ORIGPOS);
    IF ( NOT EDT$$RNG_REPOS (.RAN)) THEN RETURN;
    FORMAT_ROUTINE = .FMT_WRRUT;

!+
! Set up so a form feed will be output immediately.
!-

    COUNT = MAX_LINES;

!+
! Open the file.
!-

    WRT_NAM [DSC$W_LENGTH] = .EXE_CURCMD [FSPCLEN];
    WRT_NAM [DSC$A_POINTER] = .EXE_CURCMD [FILSPEC];
    IFI = EDT$FILEIO (EDT$K_OPEN_OUTPUT_NOSEQ, EDT$K_WRITE_FILE, WRT_NAM);

    IF (.IFI NEQ 0) THEN
	BEGIN

!+
! Save the current terminal width and make it 132 for the printer.
!-

	SAVE_WIDTH = .TI_WID;
	TI_WID = 132;

!+
! Reset the format writing routine.
!-

	FMT_WRRUT = PRINT;

!+
! Loop through the range.
!-

	WHILE (EDT$$NXT_LNRNG (0) AND ( NOT EDT$$CHK_CC ())) DO
	    BEGIN

	    IF (.WK_LN NEQA EOB_LN) THEN
		BEGIN

!+
! Look for form-feed in the record.
!-

		IF (CH$RCHAR (CH$PTR (WK_LN [LIN_TEXT], 0, BYTE_SIZE)) EQL 12) THEN COUNT = MAX_LINES;

!+
! Check for a page skip.
!-

		IF (.COUNT EQL MAX_LINES) THEN
		    BEGIN
		    PRINT (UPLIT (%CHAR (12)), 1);

!+
! Now dump out two blank lines. First make sure that the format buffer is empty.
!-

		    FMT_CUR = CH$PTR (FMT_BUF,, BYTE_SIZE);
		    EDT$$OUT_FMTBUF ();
		    EDT$$OUT_FMTBUF ();
		    COUNT = 0;
		    END;

		COUNT = .COUNT + 1;

!+
! And print a line.
!-

		IF ( NOT EDT$$TY_CURLN ()) THEN EXITLOOP;
		END;

	    END;

	IF (.EXT_MOD) THEN EDT$$STOP_WKINGMSG ();

!+
! Reposition to the first line of the range
!-

	EDT$$CPY_MEM (POS_SIZE, RNG_SAVPOS, .CUR_BUF);
	EDT$$RD_CURLN ();

!+
! Close the file.
!-

	IF (EDT$$CHK_CC ()) THEN
	    BEGIN
	    IF ( NOT EDT$FILEIO (EDT$K_CLOSE_DEL, EDT$K_WRITE_FILE, 0)) THEN
		EDT$$FIOPN_ERR (EDT$_PRIFILCRE, WRT_NAM);
	    CC_DONE = 1;
	    END
	ELSE

	    IF ( NOT EDT$FILEIO (EDT$K_CLOSE, EDT$K_WRITE_FILE, 0)) THEN
		EDT$$FIOPN_ERR (EDT$_PRIFILCRE, WRT_NAM);

!+
! Restore the terminal width and the format write routine, and reposition to
! the original line.
!-

	TI_WID = .SAVE_WIDTH;
	FMT_WRRUT = EDT$$TI_WRLN;
	CUR_BUF = .SAVE_BUF;			! First get the buffer address
	EDT$$CPY_MEM (POS_SIZE, RNG_ORIGPOS, .CUR_BUF);
	EDT$$RD_CURLN ();
	END
    ELSE

!+
! Here if file was not opened.
!-

	EDT$$FIOPN_ERR (EDT$_PRIFILCRE, WRT_NAM);

    FMT_WRRUT = .FORMAT_ROUTINE;
    END;

END
ELUDOM