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