Trailing-Edge
-
PDP-10 Archives
-
bb-r775c-bm_tops20_ks_upd_3
-
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) 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