Google
 

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