Trailing-Edge
-
PDP-10 Archives
-
BB-AE97C-BM
-
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) 1983, 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:
!
! 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