PDP-10 Archive: 7-sources/lprint.bli from tops20-v7-ft-dist1-clock

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist1-clock - 7-sources/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) DIGITAL EQUIPMENT CORPORATION 1981, 1988.  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 THAT 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