Trailing-Edge
-
PDP-10 Archives
-
BB-R775E-BM
-
sources/edt/fchar.bli
There are 10 other files named fchar.bli in the archive. Click here to see a list.
%TITLE 'FCHAR - put a char in format buffer'
MODULE FCHAR ( ! Put a char in format buffer
IDENT = '3-003' ! File: FCHAR.BLI Edit: CJG3003
) =
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:
!
! Put a character in the option buffer, expanding control characters
! and watching for line overflow.
!
! ENVIRONMENT: Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: March 18, 1979
!
! MODIFIED BY:
!
! 1-001 - Original. DJS 19-FEB-1981. This module was created by
! extracting routine EDT$$FMT_CH from module FORMAT.
! 1-002 - Regularize headers. JBS 05-Mar-1981
! 1-003 - Change output of <FF> to user string. STS 07-Oct-1981
! 1-004 - Don't count <FF>'s width twice. JBS 05-May-1982
! 1-005 - Correct appearance of <CR>. JBS 07-May-1982
! 1-006 - Add supplemental set from DEC STD 169. JBS 11-Aug-1982
! 1-007 - Update EDT$$G_PRV_COL. JBS 30-Sep-1982
! 1-008 - Remove external declaration of EDT$$FMT_LIT, not used. JBS 05-Oct-1982
! 1-009 - Don't increment EDT$$G_PRV_COL beyond the size of the screen. JBS 16-Oct-1982
! 1-010 - Don't output the buffer based on the terminal's width. JBS 16-Oct-1982
! 1-011 - Remove optimization of simple characters, now done by caller. JBS 04-Jan-1983
! 1-012 - Add conditional for VT220 support. JBS 10-Feb-1983
! 1-013 - Take out unecessary declarations. SMB 23-Feb-1983
! 1-014 - Put character names in DATA and revise the format of the table. JBS 04-Mar-1983
! 1-015 - Correct display on 8-bit terminals. JBS 07-Mar-1983
! 3-002 - Remove VT220 conditional to speed up code. CJG 25-Nov-1983
! 3-003 - Fix problems with edge of screen. CJG 9-Jan-1984
!--
%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!
REQUIRE 'EDTSRC:TRAROUNAM';
FORWARD ROUTINE
EDT$$FMT_CH : NOVALUE;
!
! INCLUDE FILES:
!
REQUIRE 'EDTSRC:EDTREQ';
LIBRARY 'EDTSRC:TRANSLATE';
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
! NONE
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
! In the routine
%SBTTL 'EDT$$FMT_CH - put a char in format buffer'
GLOBAL ROUTINE EDT$$FMT_CH ( ! Put a char in the format buffer
FC ! Character to print
) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Place a character in the format buffer. If the character would cause
! the buffer to overflow, or a line to be longer than the terminal width,
! then write the buffer first. Control chraracters are printed out either
! with a special mnemonic like <CR> or as ^letter. Tabs are expanded into
! the correct number of spaces. If this is not an eight-bit terminal,
! all characters above 127 are printed using a name in <>. If this is an
! eight-bit terminal controls above 127 are printed as <mnemonic>, reserved
! positions above 127 are printed as <Xnn>, where nn is the hex for the
! character.
!
! FORMAL PARAMETERS:
!
! FC The character to print
!
! IMPLICIT INPUTS:
!
! PRV_COL
! TI_WID
! EIGHT_BIT
! FMT_LNPOS
!
! IMPLICIT OUTPUTS:
!
! FMT_LNPOS
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
EXTERNAL ROUTINE
EDT$$FMT_TEXT : NOVALUE, ! Output the text for form feed
EDT$$STORE_FMTCH : NOVALUE; ! Put a character in the format buffer
EXTERNAL
TI_WID, ! Terminal width
EIGHT_BIT, ! Is terminal in eight-bit mode?
FMT_LNPOS, ! The current column number
CHAR_INFO : BLOCKVECTOR [256, 1], ! Information about each character
CHAR_NAMES, ! Names of some characters
CHAR_NAMES_LEN, ! Length of the name table
PRV_COL; ! Cursor column
LOCAL
C;
C = .FC;
!+
! Watch for special cases.
!-
SELECTONE .C OF
SET
[ASC_K_TAB] :
BEGIN
DO
BEGIN
EDT$$FMT_CH (%C' ');
END
UNTIL ((.FMT_LNPOS AND 7) EQL 0)
END;
[ASC_K_FF] :
BEGIN
!+
! Handle form feed specially.
!-
EDT$$FMT_TEXT (1);
END;
[OTHERWISE] :
BEGIN
!+
! This is not a special case character, dispatch on its type.
!-
CASE .CHAR_INFO [.C, CI_DSP] FROM 0 TO 3 OF
SET
[0] :
BEGIN
!+
! This is a simple character; it can be printed on this terminal in one column.
! Bump the column number by the amount occupied by this character.
!-
FMT_LNPOS = .FMT_LNPOS + 1;
EDT$$STORE_FMTCH (.C);
PRV_COL = .PRV_COL + 1;
END;
[1] :
BEGIN
!+
! This character is to be output as ^ followed by the character code plus 64.
!-
EDT$$FMT_CH (%C'^');
EDT$$FMT_CH (.C + 64);
END;
[2] :
BEGIN
!+
! This character has a special text form. Find it in the table
! and output the special form surrounded by <>. However, characters above the C1 controls are
! output as themselves on 8-bit terminals.
!-
LOCAL
REP_PTR,
REP_CHAR;
IF (.EIGHT_BIT AND (.C GEQ %X'A0'))
THEN
BEGIN
!+
! This is a legitimate character in the DEC Multinational supplemental set, being displayed
! on an eight-bit terminal.
!-
FMT_LNPOS = .FMT_LNPOS + 1;
EDT$$STORE_FMTCH (.C);
PRV_COL = .PRV_COL + 1;
END
ELSE
BEGIN
REP_PTR = CH$PTR (CHAR_NAMES - 1 + .CHAR_INFO [.C, CI_PTR],, 9);
EDT$$FMT_CH (%C'<');
REP_CHAR = CH$RCHAR_A (REP_PTR);
WHILE (.REP_CHAR NEQ 0) DO
BEGIN
EDT$$FMT_CH (.REP_CHAR);
REP_CHAR = CH$RCHAR_A (REP_PTR);
END;
EDT$$FMT_CH (%C'>');
END;
END;
[3] :
BEGIN
!+
! This character is to be output as <Xnn>, where nn is the hex for the character.
!-
LOCAL
HEX_DIGIT_1,
HEX_DIGIT_2;
EDT$$FMT_CH (%C'<');
EDT$$FMT_CH (%C'X');
HEX_DIGIT_1 = (.C^-4) + %C'0';
IF (.HEX_DIGIT_1 GTR %C'9') THEN HEX_DIGIT_1 = .HEX_DIGIT_1 - %C'9' + %C'A' - 1;
EDT$$FMT_CH (.HEX_DIGIT_1);
HEX_DIGIT_2 = (.C AND %X'0F') + %C'0';
IF (.HEX_DIGIT_2 GTR %C'9') THEN HEX_DIGIT_2 = .HEX_DIGIT_2 - %C'9' + %C'A' - 1;
EDT$$FMT_CH (.HEX_DIGIT_2);
EDT$$FMT_CH (%C'>');
END;
TES;
END;
TES;
END; ! of routine EDT$$FMT_CH
!<BLF/PAGE>
END ! of module EDT$FCHAR
ELUDOM