Google
 

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