Trailing-Edge
-
PDP-10 Archives
-
bb-r775e-bm_tops20_ks_upd_5
-
sources/edt/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) 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 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