Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
7-sources/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) 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:
!
! 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