Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
7-sources/lxprint.bli
There are 10 other files named lxprint.bli in the archive. Click here to see a list.
%TITLE 'LXPRINT - type the current line on the terminal'
MODULE LXPRINT ( ! Type the current line on the terminal
IDENT = '3-004' ! File: LXPRINT.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 displays the current line on the terminal.
!
! 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 routine EDT$$TY_CURLN from the module EXEC.BLI.
! 1-002 - Regularize headers. JBS 23-Mar-1981
! 1-003 - Change [EOB] to user defined string. STS 06-Oct-1981
! 1-004 - Use EDT$$FMT_CRLF instead of EDT$$OUT_FMTBUF. JBS 05-Jul-1982
! 1-005 - Turn off the working message. JBS 07-Jul-1982
! 1-006 - Modify the alphabetic processing. JBS 19-Jul-1982
! 1-007 - Put edt$$tst_eob in line. STS 22-Sep-1982
! 1-008 - Don't print beyond the terminal's width. JBS 22-Oct-1982
! 1-009 - Use EDT$$G_FMT_LNPOS instead of EDT$$G_PRV_COL to measure against terminal's width. JBS 01-Nov-1982
! 1-010 - Add VT220 support conditional. JBS 11-Feb-1983
! 3-001 - Make POINTER a real string pointer for Tops10/20. GB 1-Feb-1983
! 3-002 - Add updates from V3 source kit. GB 03-May-1983
! 3-003 - Remove VT220 conditional to speed up code. CJG 25-Nov-1983
! 3-004 - Modify ASSERT macro to include error code. CJG 30-Jan-1984
!--
%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!
REQUIRE 'EDTSRC:TRAROUNAM';
FORWARD ROUTINE
EDT$$TY_CURLN; ! Display the current line
!
! INCLUDE FILES:
!
REQUIRE 'EDTSRC:EDTREQ';
LIBRARY 'EDTSRC:TRANSLATE';
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
! NONE
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
! In the routine
%SBTTL 'EDT$$TY_CURLN - type the current line on the terminal'
GLOBAL ROUTINE EDT$$TY_CURLN ! Type the current line on the terminal
=
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine displays the current line on the terminal. If the
! NOS flag is on the line number is displayed before the line.
! If case flagging is enabled it is handled by this routine.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! CAS_FLG
! NOS
! WK_LN
! EXE_SBITS
! EXE_SBLK
! TI_WID
! FMT_LNPOS
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! Same as EDT$$FMT_CRLF
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
EXTERNAL ROUTINE
EDT$$FMT_CH : NOVALUE, ! Output a character
EDT$$FMT_CHWID, ! Compute a character's width
EDT$$FILL_LNO : NOVALUE, ! Output a line number
EDT$$FMT_TEXT : NOVALUE, ! Output an [EOB] or other text selected by the user
EDT$$FMT_CRLF, ! End of the output line
EDT$$STOP_WKINGMSG : NOVALUE; ! Turn off the "working" message
EXTERNAL
CAS_FLG, ! Upper and lower-case flagging
NOS, ! Print line numbers
WK_LN : REF LIN_BLOCK, ! Current line of text in the work file
EOB_LN, ! [EOB] line
EXE_SBITS, ! The options switches.
EXE_SBLK : REF NODE_BLOCK, ! The option switch value block.
CHAR_INFO : BLOCKVECTOR [256, 1], ! Information about characters
TI_WID, ! Width of the terminal
FMT_LNPOS; ! Horizontal position for formatting purposes
LOCAL
POINTER, ! Pointer into the line
LEN;
!+
! Make sure the "working" message is not still printing.
!-
EDT$$STOP_WKINGMSG ();
!+
! Check for the special case of end of buffer and display [EOB] or user's string
!-
IF (.WK_LN EQLA EOB_LN)
THEN
EDT$$FMT_TEXT (0)
ELSE
BEGIN
!+
! Print the line number if numbers are enabled.
!-
IF .NOS THEN EDT$$FILL_LNO ();
!+
! Get the length of the line to display. Normally this is just the
! length of the line, but if the /BRIEF option is on, we need to
! minimize it with the value of the qualifier.
!-
LEN = .WK_LN [LIN_LENGTH];
IF .EXE_SBITS<OPB_BRIEF>
THEN
BEGIN
!+
! If no value was specified, use 10 for the length.
!-
IF (.EXE_SBLK [SW_VAL1] EQL 0) THEN EXE_SBLK [SW_VAL1] = 10;
IF (.EXE_SBLK [SW_VAL1] LSSU .LEN) THEN LEN = .EXE_SBLK [SW_VAL1];
END;
!+
! Get a pointer to the line.
!-
POINTER = CH$PTR (WK_LN [LIN_TEXT],, BYTE_SIZE);
!+
! Increment our way through the line.
!-
INCR I FROM 1 TO .LEN DO
BEGIN
!+
! Determine if the character needs to be flagged with
! a leading apostrophe.
!-
LOCAL
FLAG_CHAR, ! 1 = we must flag the character
CHAR, ! The character to print
NEW_POS;
CHAR = CH$RCHAR_A (POINTER);
CASE .CAS_FLG FROM 0 TO 2 OF
SET
[0] : ! No case flagging
BEGIN
FLAG_CHAR = 0;
END;
[1] : ! Flag upper case letters
BEGIN
IF .CHAR_INFO [.CHAR, CI_UC] ! Upper case letter
THEN
FLAG_CHAR = 1
ELSE
FLAG_CHAR = 0;
END;
[2] : ! Flag lower case letters
BEGIN
IF .CHAR_INFO [.CHAR, CI_LC] ! Lower case letter
THEN
FLAG_CHAR = 1
ELSE
FLAG_CHAR = 0;
END;
[OUTRANGE] :
ASSERT (18, 0);
TES;
!+
! See if there is room for this character on the line. If not, break the line here.
!-
NEW_POS = .FMT_LNPOS + .FLAG_CHAR + EDT$$FMT_CHWID (.CHAR, .FMT_LNPOS + .FLAG_CHAR);
IF (.NEW_POS GEQ .TI_WID) THEN EDT$$FMT_CRLF ();
!+
! Output the flag if needed.
!-
IF .FLAG_CHAR THEN EDT$$FMT_CH (%C'''');
!+
! And, finally, output the character.
!-
EDT$$FMT_CH (.CHAR);
END;
END;
!+
! Terminate the line.
!-
RETURN (EDT$$FMT_CRLF ());
END; ! of routine EDT$$TY_CURLN
END
ELUDOM