Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/prgetkey.bli
There are 10 other files named prgetkey.bli in the archive. Click here to see a list.
 %TITLE 'PRGETKEY - parse a key name'
MODULE PRGETKEY (				! Parse a command
		IDENT = '3-004'			! File: PRGETKEY.B36 Edit:CJG3004
		) =
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:
!
!	Parse a key name.
!
! ENVIRONMENT:	Runs on TOPS-20 only
!
! AUTHOR: Chris Gill, CREATION DATE: March 15, 1983
!
! MODIFIED BY:
!
! 3-001 - Original. CJG 15-Mar-1983
! 3-002 - Fix key numbering for latest version. CJG 17-Jun-1983
! 3-003 - Allow quoted string in GOLD X formats. CJG 8-Jul-1983
! 3-004 - Check for control-C being typed. CJG 5-Jan-1984
!--

%SBTTL 'DECLARATIONS'
!
! TABLE OF CONTENTS:
!

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
	EDT$$PA_GET_KEY,		! Parse a key name
	EDT$$PA_GET_CHAR;		! Get a single character

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

REQUIRE 'SYS:JSYS';

REQUIRE 'EDTSRC:PARLITS';

LIBRARY 'EDTSRC:KEYPADDEF';

!
! EXTERNAL REFERENCES:
!
!	In the routines
!
!
! MACROS:
!
!	NONE
!
!
! OWN STORAGE
!
!	NONE
!

%SBTTL 'EDT$$PA_GET_KEY - Parse a key name'

GLOBAL ROUTINE EDT$$PA_GET_KEY =		! Parse a key name

BEGIN

!
!FUNCTIONAL DESCRIPTION
!
! This routine parses the key name in a SHOW KEY or DEFINE KEY command.
!
! Key values are defined as follows:
!
!	000 - 031 = CONTROL letter
!	032 - 255 = normal characters
!	300 - 399 = number
!	400 - 499 = FUNCTION number
!	500 - 531 = GOLD CONTROL letter
!	532 - 755 = GOLD character
!	800 - 899 = GOLD number
!	900 - 999 = GOLD FUNCTION number
!	127       = DELETE
!	627       = GOLD DELETE
!
!
!
!IMPLICIT INPUTS
!
!	NONE
!
!ROUTINE VALUE
!
!	0  - Reparse required
!	-1 - Error in parsing
!	1  - Good return
!

    EXTERNAL
	CSB : VECTOR [10],		! Command state block
	PA_CURCMD : REF NODE_BLOCK,
	PA_CURTOK,			! Pointer to atom
	PA_CURTOKLEN,			! Length of atom
	PA_ERRNO,			! Error number
	FD_KYS,
	FD_KYN,
	FD_SKY,
	FD_SKG,
	FD_SKV,
	CC;				! Control-C flag

    EXTERNAL ROUTINE
	EDT$$PA_SCANTOK;		! Find atom length and pointer

    MESSAGES ((KEYNOTDEF));

    LOCAL
	C_FLAG,				! COMND flags
	C_DATA,				! COMND data pointer
	C_FDB,				! COMND actual FDB used
	C1,
	C2,				! Offset for GOLD keys
	C3;				! Flag for quoted string

    BEGIN
	PA_ERRNO = EDT$_KEYNOTDEF;
	C2 = 0;
	C3 = 0;

!+
! Parse the next atom and set C1 (the atom identifier) accordingly
!-

	IF (NOT COMMAND (FD_SKY)) THEN RETURN (-1);
	IF (.CC NEQ 0) THEN RETURN (-1);
	IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
	IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
	IF ((.C_FDB<0,18> EQL FD_KYN) OR (.C_FDB<0,18> EQL FD_KYS)) THEN RETURN (-1);
	IF (.C_FDB<0,18> EQL FD_SKV) THEN
	    C1 = KEY_NUM
	ELSE
	    C1 = .(.C_DATA)<0,18>;

	IF (.C1 EQL KEY_GOLD) THEN
	    BEGIN
	    C2 = K_GOLD_BASE;

!+
! The GOLD keyword may be followed by another keyword - parse it as well
!-

	    IF (NOT COMMAND (FD_SKG)) THEN RETURN (-1);
	    IF (.CC NEQ 0) THEN RETURN (-1);
	    IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
	    IF ((.C_FLAG AND CM_NOP) NEQ 0) THEN RETURN (-1);
	    C1 = (SELECTONE .C_FDB<0,18> OF
		    SET
		    [ FD_SKV ] : KEY_NUM;
		    [ FD_SKG ] : .(.C_DATA)<0,18>;
		    [ FD_KYS ] : 0;
		    [ FD_KYN ] :
				BEGIN
				C3 = 1;
				0
				END;
		    TES );
	    END;

	CASE .C1 FROM 0 TO KEY_FUNC OF
	    SET

	[ 0 ] :

	    BEGIN

!+
! DEFINE GOLD x
!-

	    EDT$$PA_SCANTOK (.C3,1);
	    IF (.PA_CURTOKLEN EQL 0) THEN
		BEGIN
		C1 = CH$RCHAR_A (CSB [$CMPTR]);
		CSB [$CMINC] = .CSB [$CMINC] - 1;
		END
	    ELSE
		BEGIN
		IF (.PA_CURTOKLEN NEQ 1) THEN RETURN (-1);
		C1 = CH$RCHAR_A (PA_CURTOK);
		END;

	    IF ((.C1 LEQ ASC_K_SP) OR (.C1 GTR %C'^')) THEN RETURN (-1);
	    PA_CURCMD [KEY_VAL] = .C1 + .C2;
	    END;

	[ KEY_NUM ] :

	    BEGIN

!+
! DEFINE (GOLD) nn
!-

	    IF (.C_DATA GTR 21) THEN RETURN (-1);
	    PA_CURCMD [KEY_VAL] = .C_DATA + .C2 + K_KPAD_BASE;
	    END;

	[ KEY_DEL ] :

	    BEGIN

!+
! DEFINE (GOLD) DELETE
!-

	    PA_CURCMD [KEY_VAL] = 127 + .C2;
	    END;

	[ KEY_CONT ] :

	    BEGIN

!+
! DEFINE (GOLD) CONTROL x
!-

	    C1 = EDT$$PA_GET_CHAR ();
	    IF (.C1 LEQ 0) THEN RETURN (.C1);
	    IF ((.C1 LEQ %C'@') OR (.C1 GTR %C'Z')) THEN RETURN (-1);
	    PA_CURCMD [KEY_VAL] = .C1 - %C'@' + .C2;
	    END;

	[ KEY_FUNC ] :

	    BEGIN

!+
! (GOLD) FUNCTION nn
!-

	    IF (NOT COMMAND (FD_SKV)) THEN RETURN (-1);
	    IF (.CC NEQ 0) THEN RETURN (-1);
	    IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
	    IF (.C_DATA GTR 99) THEN RETURN (-1);
	    PA_CURCMD [KEY_VAL] = .C_DATA + .C2 + K_FUN_BASE;
	    END;

	    TES;

	RETURN (1);

    END;
END;

%SBTTL 'EDT$$PA_GET_CHAR - Parse a single character'

GLOBAL ROUTINE EDT$$PA_GET_CHAR =			! Parse a character

BEGIN

!+
!FUNCTIONAL DESCRIPTION
!
! Since there is no COMND function to parse a single, arbitrary, character,
! this routine simulates it by parsing an alphanumeric field and returning
! either the first character or the break character if no field was parsed.
! If a COMND error occurs, the field was longer than one character, or a
! reparse is required, an error return is taken.
!-

!
!ROUTINE VALUE
!
!	0  - Reparse required
!	-1 - Error or field too long
!	1  - Good return
!

    EXTERNAL
	FD_KYN,
	FD_KYS,
	PA_CURTOK,
	PA_CURTOKLEN,
	CC,					! Control-C flag
	CSB : VECTOR [10];

    EXTERNAL ROUTINE
	EDT$$PA_SCANTOK;			! Get atom length and pointer

    LOCAL
	C_DATA,
	C_FDB,
	C_FLAG,
	C1;

    BEGIN

	IF (NOT COMMAND (FD_KYN)) THEN RETURN (-1);
	IF (.CC NEQ 0) THEN RETURN (-1);
	IF ((.C_FLAG AND CM_RPT) NEQ 0) THEN RETURN (0);
	IF (.C_FDB<0,18> EQL FD_KYN) THEN C1 = 1 ELSE C1 = 0;

	EDT$$PA_SCANTOK (.C1,1);
	IF (.PA_CURTOKLEN EQL 0) THEN
	    BEGIN
	    CSB [$CMINC] = .CSB [$CMINC] - 1;
	    C_DATA= CH$RCHAR_A (CSB [$CMPTR]);
	    END
	ELSE
	    BEGIN
	    IF (.PA_CURTOKLEN NEQ 1) THEN RETURN (-1);
	    C_DATA= CH$RCHAR_A (PA_CURTOK);
	    END;

	RETURN (.C_DATA);

    END;
END;

END
ELUDOM