Trailing-Edge
-
PDP-10 Archives
-
bb-r775d-bm_tops20_ks_upd_4
-
sources/keychr.bli
There are 10 other files named keychr.bli in the archive. Click here to see a list.
%TITLE 'KEYCHR - get next command character'
MODULE KEYCHR ( ! Get next command character
IDENT = '3-003' ! File: KEYCHR.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:
!
! Get next command character.
!
! ENVIRONMENT: Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: April 7, 1979
!
! MODIFIED BY:
!
! 1-001 - Original. DJS 24-Feb-1981. This module was created by
! extracting routine EDT$$NXT_CMDCH from module KEYTRAN.
! 1-002 - Regularize headers. JBS 06-Mar-1981
! 1-003 - Add a check for repeat counts allowed or not. STS 26-Aug-1981
! 1-004 - Fixed problem with norepeat so it doesn't insert number.
! STS 27-Aug-1981
! 1-005 - Add return value for end of journal file. JBS 02-Oct-1981
! 1-006 - Don't pass values of keypad except arrow keys. STS 15-Apr-1982
! 1-007 - Accept a flag indicating validity of repeat counts. STS 16-Jun-1982
! 1-008 - Remove reference to TI_STARTECHO. SMB 22-Jun-1982
! 1-009 - Change numeric test. JBS 19-Jul-1982
! 1-010 - Don't ring bell if quiet set. STS 09-Aug-1982
! 1-011 - New implementation of defined keys. JBS 13-Aug-1982
! 1-012 - Don't suppress all keys in NOKEYPAD mode. JBS 16-Aug-1982
! 1-013 - Fix up norepeat case. JBS 16-Aug-1982
! 1-014 - Allow for 8-bit keyboards. JBS 17-Aug-1982
! 1-015 - Add SS3 for 8-bit keyboards. JBS 20-Aug-1982
! 1-016 - Erase the message line after the first keystroke, if it has
! a message on it. JBS 06-Oct-1982
! 1-017 - Output the format buffer just before waiting for input, in case
! there is anything in it. JBS 07-Oct-1982
! 1-018 - Don't clear the message line until an entire key sequence has been read.
! JBS 09-Oct-1982
! 1-019 - Output the format buffer in another case of waiting for input. JBS 09-Oct-1982
! 1-020 - Change the call to EDT$$TST_KEYDEF. JBS 14-Dec-1982
! 1-021 - Complete the implementation of 8-bit keyboards. JBS 20-Jan-1983
! 1-022 - Add a conditional for VT220 support. JBS 11-Feb-1983
! 3-001 - Update from V3 sources. GB 18-May-1983
! 3-002 - Remove VT220 conditionals. CJG 25-Nov-1983
! 3-003 - Call EDT$$STORE_FMTCH directly. CJG 5-Jan-1984
!--
%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!
REQUIRE 'EDTSRC:TRAROUNAM';
FORWARD ROUTINE
EDT$$NXT_CMDCH;
!
! INCLUDE FILES:
!
REQUIRE 'EDTSRC:EDTREQ';
LIBRARY 'EDTSRC:KEYPADDEF';
LIBRARY 'EDTSRC:TRANSLATE';
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
! NONE
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
! In the routine
%SBTTL 'EDT$$NXT_CMDCH - get next command character'
GLOBAL ROUTINE EDT$$NXT_CMDCH ( ! Get next command character
C, ! Place to store the character
REPEAT ! Accept repeat counts
) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Get the next command character. Keypad keys are converted to their
! numeric equivalent and the functions of GOLD are handled here.
!
! FORMAL PARAMETERS:
!
! C The address of a fullword to receive the character.
!
! REPEAT Flag indicating whether to accept repeat counts.
!
! IMPLICIT INPUTS:
!
! CMD_BUF
! KPAD
! CMD_PTR
! RPT
! CMD_END
! MSGFLG
!
! IMPLICIT OUTPUTS:
!
! CMD_PTR
!
! ROUTINE VALUE:
!
! 0 = control U typed, no command.
! 1 = a command key was typed.
! 2 = end of journal file.
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
EXTERNAL ROUTINE
EDT$$SC_REVID, ! Turn on reverse video
EDT$$PUT_CMDCH : NOVALUE, ! Put a character in the command buffer
EDT$$TRN_KPADK, ! Read an escape sequence
EDT$$TI_INPCH,
EDT$$TI_DELK,
EDT$$TI_ECHOCH,
EDT$$ERA_MSGLN, ! Erase the message lines
EDT$$STORE_FMTCH, ! Store a character
EDT$$TST_KEYDEF, ! Test a key to see if it is defined as a particular string
EDT$$OUT_FMTBUF; ! Output the format buffer, if it is non-empty
EXTERNAL
MSGFLG, ! 1 = there is text on the message line
QUIET, ! quiet flag
CMD_BUF, ! Command buffer
CMD_PTR, ! Pointer to next char in command buffer
KPAD, ! in keypad mode?
RPT, ! Flag for repeat counts
CMD_END, ! Pointer to end of info in command buffer
CHAR_INFO : BLOCKVECTOR [256, 1]; ! Information about characters
LOCAL
SAVE_POINT, ! Starting CMD_PTR .
MY_C;
SAVE_POINT = .CMD_PTR;
!+
! Make sure the user sees anything which might be in the format buffer.
!-
EDT$$OUT_FMTBUF ();
!+
! Get a character.
!-
IF (EDT$$TI_INPCH (MY_C) EQL 0) THEN RETURN (2);
!+
! If the character is an escape, CSI or SS3, then look for a keypad sequence.
!-
IF .CHAR_INFO [.MY_C, CI_ESC]
THEN
BEGIN
!+
! Translate keypad character.
!-
IF (EDT$$TRN_KPADK (MY_C) EQL 0) THEN RETURN (2);
!+
! If there is any text on the message line, erase it, since the user
! has now had an opportunity to read it.
!-
IF (.MSGFLG NEQ 0) THEN EDT$$ERA_MSGLN ();
IF ( NOT .KPAD)
THEN
BEGIN
IF ((.MY_C EQL K_UP) OR (.MY_C EQL K_DOWN) OR (.MY_C EQL K_RIGHT) OR (.MY_C EQL K_LEFT))
THEN
.C = .MY_C
ELSE
.C = K_PF1;
RETURN (1);
END;
END;
!+
! If the key is defined as GOLD, handle it here.
!-
WHILE EDT$$TST_KEYDEF (.MY_C, UPLIT ('GOLD'), 4, 0) DO
BEGIN
!+
! Look at the next character. It should be either a digit, a sign
! or a letter.
!-
EDT$$OUT_FMTBUF ();
IF (EDT$$TI_INPCH (MY_C) EQL 0) THEN RETURN (2);
EDT$$SC_REVID ();
IF ((.CHAR_INFO [.MY_C, CI_DIG] OR (.MY_C EQL %C'-')) AND .REPEAT)
THEN
BEGIN
!+
! Start of a repeat count. If this was not the first key pressed
! then re-start the count by clearing the buffer back to the
! point where we started.
!-
IF (.RPT EQL 0)
THEN
BEGIN
IF ( NOT .QUIET) THEN EDT$$STORE_FMTCH (7);
EDT$$OUT_FMTBUF ();
IF (EDT$$TI_INPCH (MY_C) EQL 0) THEN RETURN (2);
IF .CHAR_INFO [.MY_C, CI_ESC]
THEN
BEGIN
IF (EDT$$TRN_KPADK (MY_C) EQL 0) THEN RETURN (2);
END;
END
ELSE
BEGIN
IF CH$PTR_NEQ (.CMD_PTR, .SAVE_POINT)
THEN
BEGIN
CMD_PTR = .SAVE_POINT;
EDT$$ERA_MSGLN ();
END;
!+
! Now continue reading and echoing characters until a non-digit is found.
!-
DO
BEGIN
EDT$$TI_ECHOCH (.MY_C);
EDT$$PUT_CMDCH (.MY_C, 0);
EDT$$OUT_FMTBUF ();
IF (EDT$$TI_INPCH (MY_C) EQL 0) THEN RETURN (2);
!+
! Look for delete and CTRL/U
!-
WHILE (.MY_C EQL ASC_K_DEL) DO
BEGIN
IF CH$PTR_NEQ (.CMD_PTR, .SAVE_POINT)
THEN
BEGIN
CMD_PTR = CH$PLUS (.CMD_PTR, -1);
EDT$$TI_DELK (CH$RCHAR (.CMD_PTR));
END;
EDT$$OUT_FMTBUF ();
IF (EDT$$TI_INPCH (MY_C) EQL 0) THEN RETURN (2);
END;
IF (.MY_C EQL ASC_K_CTRL_U)
THEN
BEGIN
EDT$$ERA_MSGLN ();
CMD_END = CH$PTR (CMD_BUF,, BYTE_SIZE);
RETURN (0);
END;
END
UNTIL (NOT .CHAR_INFO [.MY_C, CI_DIG]);
!+
! If the repeat sequence was ended by an escape, CSI or SS3 then get the key.
!-
IF .CHAR_INFO [.MY_C, CI_ESC]
THEN
BEGIN
IF (EDT$$TRN_KPADK (MY_C) EQL 0) THEN RETURN (2);
END;
END
END
ELSE
IF .CHAR_INFO [.MY_C, CI_ESC]
THEN
!+
! Here if we had gold followed by an escape, CSI or SS3.
! Translate the sequence and use the golded function of the key.
!-
BEGIN
IF (EDT$$TRN_KPADK (MY_C) EQL 0) THEN RETURN (2);
MY_C = .MY_C + K_GOLD_BASE;
END
ELSE
BEGIN
!+
! Here if we had gold followed by a character from the main keyboard.
!-
IF .CHAR_INFO [.MY_C, CI_LC] ! Lower case
THEN
MY_C = .MY_C - %C'a' + %C'A'; ! Force to upper
MY_C = .MY_C + K_GOLD_BASE;
END;
END;
!+
! Return the coded character.
!-
.C = .MY_C;
RETURN (1);
END; ! of routine EDT$$NXT_CMDCH
!<BLF/PAGE>
END ! of module EDT$$KEYCHR
ELUDOM