Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE LIB$RECOG (
		IDENT = 'V01A30'
		 ) =
BEGIN

!
!			  COPYRIGHT (C) 1982,1983 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! 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:	HELP
!
! ABSTRACT:
!
!	Handles incremental help and recognition.
!
! ENVIRONMENT:
!
! AUTHOR: Stanley Rabinowitz,	CREATION DATE: 4-JUL-80
!
! MODIFIED BY: Stanley Rabinowitz
!
! V01A30	Stan	 6-Jul-1983	Allow radix 2-10,16 for numbers
!--

!LITERAL	HLP$K_KEYWORD_MAX = 150;	! ***

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE

	LIB$$KEYWORD_HELP	: NOVALUE,
	LIB$$KEYWORD_RECOG,
	LIB$$NUMBER_RECOG,
	LIB$$TOKEN_RECOG,
	LIB$$NO_RECOG,
	LIB$$END_HELP		: NOVALUE,
	LIB$$GENERAL_HELP	: NOVALUE,
	LIB$OUT_RECOG		: NOVALUE,
	LIB$$FILENAME_RECOG,
!	RECOG_DOCUMENT,
	FIRST_SCAN,
	SECOND_SCAN,
	LIB$$DIRECTORY_RECOG,
	LIB$$BREAK_RECOG	: NOVALUE;	! Prevent multi-field recognition

!
! INCLUDE FILES:
!

REQUIRE 'HLP.R32';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!

OWN

	HLP$BUF_DESC	: VECTOR[2],	! Descriptor for command line buffer
	BUF		: VECTOR[200,BYTE],! Address of buffer to contain
	HANDLE;

!
! EXTERNAL REFERENCES:
!

EXTERNAL LITERAL

	HLP$_DEBUG_RECOG,	! May be signalled only if SET COMMAND/DEBUG
	HLP$_REPARSE;		! Signalled internally to cause a re-parse

EXTERNAL ROUTINE

	LIB$COLLECT_INITIALIZE,
	LIB$COLLECT_ABORT,
	LIB$COLLECT_STORE,
	LIB$COLLECT_OUTPUT;

ROUTINE	HLP$WILDMAN=1;
ROUTINE	HLP$RESTORE_STATE=1;

!ROUTINE HLP$OUTPUT(A,B,CHAN)=HLP$PUT_OUTPUT(.A,.B,.CHAN);

LITERAL

	FILNAM_SIZ	= NAM$C_MAXRSS,
	DFAULT_SIZ	= NAM$C_MAXRSS,
	EXPAND_SIZ	= NAM$C_MAXRSS,
	RESULT_SIZ	= NAM$C_MAXRSS,
	RELATE_SIZ	= NAM$C_MAXRSS;

OWN

	FILNAM_BUF	: VECTOR[FILNAM_SIZ,BYTE],
	DFAULT_BUF	: VECTOR[DFAULT_SIZ,BYTE],
	EXPAND_BUF	: VECTOR[EXPAND_SIZ,BYTE],
	RESULT_BUF	: VECTOR[RESULT_SIZ,BYTE],
	RELATE_BUF	: VECTOR[RELATE_SIZ,BYTE],
	RELATE_NAM	: $NAM(	RSA = RELATE_BUF,
				RSS = RELATE_SIZ) VOLATILE,
	RECNIZ_NAM	: $NAM(	ESA = EXPAND_BUF,
				ESS = EXPAND_SIZ,
				RSA = RESULT_BUF,
				RSS = RESULT_SIZ,
				RLF = RELATE_NAM) VOLATILE,
	RECNIZ_FAB	: $FAB(	NAM = RECNIZ_NAM) VOLATILE,
	DUMMY_RAB	: $RAB_DECL VOLATILE;

OWN

	CURKEY_LEN	: WORD,
	CURKEY_ADR,
	TOTAL_SIZE,
	MAX_SIZE,
	KEY_COUNT;

LITERAL

	MAX_WIDTH=132,	! maximum size of any one line
	INTERSPACE=2;	! space between keywords (if they fit on one line)

OWN

	QUALIFIER_MODE,	! 1 if qualifier field
	TERM_WIDTH,	! Actual width of line
	COLUMN,		! Number of characters in line buffer.
	TABPOS,		! Index number of next tabs top.
	FIELD_SIZE,	! Width of field in which to print keyword
	LINE		: VECTOR[MAX_WIDTH,BYTE];

OWN

	EXPAND_DESC	: VECTOR[2] INITIAL(EXPAND_SIZ,EXPAND_BUF),
	RESULT_DESC	: VECTOR[2] INITIAL(RESULT_SIZ,RESULT_BUF),
	EXCESS_DESC	: VECTOR[2],
	UNIQUE_DESC	: VECTOR[2];

EXTERNAL ROUTINE

	LIB$SCAN_KEYWORD_TABLE,
	LIB$ANALYZE_SDESC;

GLOBAL ROUTINE LIB$$KEYWORD_HELP(P_PAB) : NOVALUE =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Called in response to the HELP key applied to a keyword parameter.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB.
!
! IMPLICIT INPUTS:
!
!	PAB
!	CAB
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

BIND

	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	PTR	=  CAB[CAB$W_PTR]	: VOLATILE WORD,
	TYP	=  PAB[PAB$B_TYP]	: BYTE,
	INI	=  CAB[CAB$W_FLD_PTR]	: WORD,
	MTAB	= .PAB[PAB$L_ARG]	: VECTOR,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE],
	HLP	= .PAB[PAB$A_HLP]	: BLOCK[,BYTE];

LOCAL

	STATUS,
	Q_NUMS,		! number of qualifiers
	NEW_STRUC,	! 1 if using new keyword table structure
	PART_SIZ,
	PRT		: VECTOR[2],
	KEYWORD_NAME;

EXTERNAL ROUTINE

	STR$UPCASE;

OWN

	UC_PRT	: BLOCK[8,BYTE]
		PRESET(	[DSC$W_LENGTH]	= 0,
			[DSC$B_CLASS]	= DSC$K_CLASS_D,
			[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			[DSC$A_POINTER]	= 0);

LITERAL

	MAX_EXPAND	= 25;	! Maximum width we allow any column
				! of qualifiers expand to

! Do we have a bug if a qualifier is wider than terminal width? ***

!+
! If this is a keyword field, then set QUALIFIER_MODE false.
! If this is a qualifier field, then set QUALIFIER_MODE true.
! We rely on the fact here that TRUE is 1 and FLASE is 0
! because we add this flag into the buffer pointer to bump
! the pointer by 1 when we are dealing with qualifiers.
!-

QUALIFIER_MODE=.TYP EQL HLP$K_QUALIFIER;

!+
!	Compute PART_SIZ, the length of the partial keyword
!	specified.  Note that this is one smaller if this is
!	a qualifier field; however it can't be smaller than 0.
!-

PART_SIZ=.PTR-.INI;
IF .QUALIFIER_MODE AND .PART_SIZ GTRU 0
  THEN	PART_SIZ=.PART_SIZ-1;

NEW_STRUC=.MTAB<31,1>;

IF .NEW_STRUC
  THEN	BEGIN
	BIND MT = MTAB : VECTOR[,BYTE];
	Q_NUMS=.MTAB[2];
	END
  ELSE	Q_NUMS=.MTAB[0]/2;

KEYWORD_NAME=(IF HLP NEQ 0 AND .HLP[DSC$W_LENGTH] NEQ 0
		 THEN HLP
		 ELSE IF .QUALIFIER_MODE
			THEN %ASCID 'qualifier'
			ELSE %ASCID 'keyword');

!+
! Scan the keyword table looking for keywords that match
! this partial keyword.  Count the number of keywords that
! match in KEY_COUNT.  While we are at it, also find the
! total size of the keywords (TOTAL_SIZE) and the largest size
! (MAX_SIZE).
!-

PRT[0]=.PART_SIZ;
PRT[1]=BUF[.INI]+.QUALIFIER_MODE;

!+
! Upcase the partial name found.
!-

STATUS=STR$UPCASE(UC_PRT,PRT);
IF NOT .STATUS THEN SIGNAL(.STATUS);

KEY_COUNT=0;
TOTAL_SIZE=0;
MAX_SIZE=0;

STATUS=LIB$SCAN_KEYWORD_TABLE(%REF(MTAB),UC_PRT,FIRST_SCAN,%REF(CAB));
IF NOT .STATUS THEN RETURN .STATUS;

!+
! Add in the fact that qualifiers output "/".
!-

IF .QUALIFIER_MODE
  THEN	TOTAL_SIZE=.TOTAL_SIZE+.KEY_COUNT;

CASE .KEY_COUNT FROM 0 TO 1 OF

    SET

    [0]:

	!+
	! Nothing matches.
	! Print KEYWORD, none match
	! unless there is precisely one legal keyword,
	! in which case print KEYWORD, does not match MUMBLE.
	!-

	BEGIN

	!+
	! Print the name of the entity, i.e., keyword, qualifier, guideword, etc.
	!-

	$OUT(.KEYWORD_NAME,HLP$K_ENTITY_LINE);

	!+
	! See if there is precisely one valid keyword.
	!-

	IF .Q_NUMS EQL 1
	  THEN	BEGIN
		$OUT(%ASCID ', does not match: ',HLP$K_SINGLE_LINE);
		IF .QUALIFIER_MODE
		  THEN	$OUT(%ASCID '/',HLP$K_SINGLE_LINE);
		IF .NEW_STRUC
		  THEN	BEGIN
			BIND QDESC = .MTAB[2];
			$OUT(QDESC,HLP$K_HELP)
			END
		  ELSE	$OUT(CSDESCR(.MTAB[1]),HLP$K_HELP)
		END
	  ELSE	$OUT(%ASCID ':  none match',HLP$K_NOMATCH_LINE);
	END;

    [1]:

	BEGIN
	LOCAL D : VECTOR[2];
	$OUT(.KEYWORD_NAME,HLP$K_ENTITY_LINE);
	IF .Q_NUMS EQL 1
	  THEN	$OUT(%ASCID ': ',HLP$K_SINGLE_LINE)
	  ELSE	$OUT(%ASCID ', only possibility is:  ',HLP$K_SINGLE_LINE);
	IF .QUALIFIER_MODE
	  THEN	$OUT(%ASCID '/',HLP$K_SINGLE_LINE);
	D[0]=.CURKEY_LEN;
	D[1]=.CURKEY_ADR;
	$OUT(D,HLP$K_HELP)
	END;

    [OUTRANGE]:

	BEGIN
	LOCAL	D : VECTOR[2];
	TERM_WIDTH=.CAB[CAB$W_WIDTH];
	IF .TERM_WIDTH EQL 0
	  THEN	TERM_WIDTH=80;	! Somehow, if we missed it.

	!+
	! Make sure the width isn't too large.
	!-

	TERM_WIDTH=MIN(.TERM_WIDTH,MAX_WIDTH);
	$OUT(.KEYWORD_NAME,HLP$K_ENTITY_LINE);
	$OUT(%ASCID ', one of the following:',HLP$K_PREFACE_LINE);

	!+
	! Set the internal COLUMN counter to 0 to make sure
	! that the first keyword starts at position 0.
	!-

	COLUMN=0;
	CH$FILL(%C' ',.TERM_WIDTH,LINE);

	!+
	! Field width is maximum size plus 1, but not more than MAX_EXPAND.
	!-

	FIELD_SIZE=MIN(.MAX_SIZE+.QUALIFIER_MODE+1,MAX_EXPAND);

	!+
	! If all the keywords can fit on a single line, equally spaced,
	! with INTERSPACE spaces between them, then set FIELD_SIZE to 0.
	!-

	IF .TOTAL_SIZE+INTERSPACE*(.KEY_COUNT-1) LEQ .TERM_WIDTH
	  THEN	FIELD_SIZE=0;

	STATUS=LIB$SCAN_KEYWORD_TABLE(%REF(MTAB),UC_PRT,SECOND_SCAN,%REF(CAB));
	IF NOT .STATUS THEN RETURN .STATUS;

	D[0] = .COLUMN;
	D[1] =  LINE;
	$OUT(D,HLP$K_HELP_LINE)
	END;

    TES;

END;

ROUTINE FIRST_SCAN(P_NAME_DESC,P_KIT,P_CTX) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Action routine for keyword scan to find the
!	number of keywords that match and to figure
!	out the length of the largest keyword and the total size
!	of the keywords.
!
! FORMAL PARAMETERS:
!
!	P_NAME_DESC	Address of descriptor for keyword
!
!	P_KIT		Address of keyword item table
!
!	P_CTX		Address of context longword
!			Points to CAB.
!
! IMPLICIT INPUTS:
!
!	MAX_SIZE	Gets updated if this keyword has a new maximum size
!
!	TOTAL_SIZE	Gets incremented to include the number of
!			characters in this keyword.
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	SS$_NORMAL
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	EQUAL_SIZE,
	NEG_SIZE,
	STATUS;

BIND

	P_CAB	= .P_CTX,
	CAB	= .P_CAB	: $CAB_DECL,
	KIT	= .P_KIT	: $KIT_DECL;

IF KIT EQL 0
  THEN	BEGIN
	NEG_SIZE=0;
	EQUAL_SIZE=0
	END
  ELSE	BEGIN
	IF .CAB[CAB$W_PTR] LEQ .CAB[CAB$W_FLD_PTR]+.QUALIFIER_MODE
	  THEN	NEG_SIZE=4*.KIT[KIT$V_NEG]
	  ELSE	NEG_SIZE=0;
	EQUAL_SIZE=.KIT[KIT$V_VAL];
	END;

!+
! Do a preliminary scan over the keywords to find the largest one
! and also to see if they will all fit on one line.
!-

STATUS=LIB$ANALYZE_SDESC(.P_NAME_DESC,CURKEY_LEN,CURKEY_ADR);
IF NOT .STATUS THEN RETURN .STATUS;

KEY_COUNT=.KEY_COUNT+1;

TOTAL_SIZE = .TOTAL_SIZE+.CURKEY_LEN+.EQUAL_SIZE+.NEG_SIZE;
MAX_SIZE = MAX(.MAX_SIZE,.CURKEY_LEN+.EQUAL_SIZE+.NEG_SIZE);

RETURN SS$_NORMAL

END;

ROUTINE SECOND_SCAN(P_NAME_DESC,P_KIT,P_CTX) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Action routine for keyword scan used to print the
!	keywords that have matched.
!
! FORMAL PARAMETERS:
!
!	P_NAME_DESC	Address of descriptor for kwyword
!
!	P_KIT		Address of keyword item table
!
!	P_CTX		Address of context longword
!			In this case, that contains address of CAB.
!
! IMPLICIT INPUTS:
!
!	QUALIFIER_MODE
!
!	FIELD_SIZE
!
!	COLUMN
!
!	TABPOS
!
!	TERM_WIDTH
!
!	LINE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	SS$_NORMAL
!
! SIDE EFFECTS:
!
!	NONE
!
!--

BIND

	KIT	= .P_KIT	: $KIT_DECL,
	P_CAB	= .P_CTX,
	CAB	= .P_CAB	: $CAB_DECL;

LOCAL

	EQUAL_SIZE,
	NEG_SIZE,
	D		: VECTOR[2],
	STATUS;

IF KIT EQL 0
  THEN	BEGIN
	NEG_SIZE=0;
	EQUAL_SIZE=0
	END
  ELSE	BEGIN
	IF .CAB[CAB$W_PTR] LEQ .CAB[CAB$W_FLD_PTR]+.QUALIFIER_MODE
	  THEN	NEG_SIZE=4*.KIT[KIT$V_NEG]
	  ELSE	NEG_SIZE=0;
	EQUAL_SIZE=.KIT[KIT$V_VAL];
	END;

STATUS=LIB$ANALYZE_SDESC(.P_NAME_DESC,CURKEY_LEN,CURKEY_ADR);
IF NOT .STATUS THEN RETURN .STATUS;

!+
! Figure out where next logical tab stop is.
! (where the next field starts).
! That is where next keyword should be put.
!-

TABPOS=	BEGIN
	IF .COLUMN EQL 0
	  THEN	0
	  ELSE	IF .FIELD_SIZE NEQ 0
		  THEN	.COLUMN+.FIELD_SIZE-
			(.COLUMN MOD .FIELD_SIZE)
		  ELSE	.COLUMN+INTERSPACE
	END;

!+
! Make sure that the next keyword will fit.
! If it would overflow the terminal width,
! then output this line and start a new line.
! Note that the column positions are labelled
! from 0 to .TERM_WIDTH-1.
!-

! Note: the next IF can be replaced by the
!	following IF should you want to ensure
!	that the final column of help keywords
!	not have any blank holes due to items
!	in THAT slot that might be too big.
!	This is entirely an esthetics problem,
!	and after trying it both ways, I chose
!	the way you see as the better.	- STAN -
!	IF .TABPOS+MAX(.CURKEY_LEN+.QUALIFIER_MODE+.EQUAL_SIZE,
!		.FIELD_SIZE) GEQ .TERM_WIDTH

IF .TABPOS+.CURKEY_LEN+.QUALIFIER_MODE+.EQUAL_SIZE+.NEG_SIZE GEQ .TERM_WIDTH
  THEN	BEGIN

	!+
	! Output the current line and end it with CRLF.
	!-

	D[0]=.COLUMN;
	D[1]=LINE;
	$OUT(D,HLP$K_HELP_LINE);
	CH$FILL(%C' ',.TERM_WIDTH,LINE);
	TABPOS=0
	END;

IF .QUALIFIER_MODE
  THEN	BEGIN
	BIND CH = LINE[.TABPOS] : BYTE;
	CH='/'
	END;

IF .NEG_SIZE NEQ 0
  THEN	CH$MOVE(4,UPLIT('[NO]'),LINE[.TABPOS]+.QUALIFIER_MODE);

CH$MOVE(.CURKEY_LEN,.CURKEY_ADR,
	LINE[.TABPOS]+.QUALIFIER_MODE+.NEG_SIZE);

!+
!	If a value is legal, then output a "=".
!-

COLUMN=.TABPOS+.CURKEY_LEN+.QUALIFIER_MODE+.NEG_SIZE;
IF .EQUAL_SIZE
  THEN	BEGIN
	BIND CH=LINE[.COLUMN] : BYTE;
	CH='=';
	COLUMN=.COLUMN+1;
	END;

RETURN SS$_NORMAL

END;

GLOBAL ROUTINE LIB$$KEYWORD_RECOG(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles recognition of keywords.
!
! FORMAL PARAMETERS:
!
!	TBS
!
! IMPLICIT INPUTS:
!
!	NONE
!
!	PAB type tells us whether this is a keyword or qualifier field.
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	TRUE		complete recognition has been accomplished
!
!	FALSE		no recognition or partial recognition
!			has been accomplished.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	QUALIFIER_MODE,	! 1 means qualifier field, 0 means keyword field
	NEW_STRUC,	! TRUE if new keyword table structure
	KWS,
	STATUS,
	D		: VECTOR[2],
	FULL_LEN	: WORD,
	FULL_VAL;

OWN

	SUB_COUNT;

BIND

	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	PTR	=  CAB[CAB$W_PTR]	: WORD,
	TYP	=  PAB[PAB$B_TYP]	: BYTE,
	KTAB	= .PAB[PAB$L_ARG]	: VECTOR,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE],
	INI	=  CAB[CAB$W_FLD_PTR]	: WORD;

OWN

	UC_DESC	: BLOCK[8,BYTE]
		PRESET(	[DSC$W_LENGTH]	= 0,
			[DSC$B_CLASS]	= DSC$K_CLASS_D,
			[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			[DSC$A_POINTER]	= 0),

	FULL_D		: BLOCK[8,BYTE] PRESET(

			[DSC$W_LENGTH]	= 0,
			[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			[DSC$B_CLASS]	= DSC$K_CLASS_D,
			[DSC$A_POINTER]	= 0);

EXTERNAL ROUTINE

	STR$UPCASE,
	LIB$SCAN_KEYWORD_TABLE,
	LIB$LOOKUP_KEYWORD;

ROUTINE ACTION(P_NAME_DESC,P_KWD,P_KWS) =
    BEGIN
    BIND KWS = .P_KWS;
    LOCAL LEN:WORD, ADR, STATUS;
    STATUS=LIB$ANALYZE_SDESC(.P_NAME_DESC,LEN,ADR,KWS);
    IF NOT .STATUS THEN RETURN .STATUS;
    STATUS=LIB$COLLECT_STORE(HANDLE,.LEN-.KWS,.ADR+.KWS);
    IF NOT .STATUS THEN RETURN .STATUS;
    SUB_COUNT=.SUB_COUNT+1;
    RETURN SS$_NORMAL
    END;

QUALIFIER_MODE = .TYP EQL HLP$K_QUALIFIER;

!+
! We do not permit recognizing the slash in a qualifier field.
!-

IF .PTR EQL .INI AND .QUALIFIER_MODE
  THEN	RETURN FALSE;

!+
! The keyword size is one smaller for qualifiers.
!-

KWS=.PTR-.INI-.QUALIFIER_MODE;

!+
!	Special case:
!	Before we do anything else, we see if this is an exact match.
!	In that case, we claim that full recognition has occurred.
!-

D[0]=.KWS;
D[1]=BUF[.INI]+.QUALIFIER_MODE;

!+
! Upcase the partial name.
!-

STATUS=STR$UPCASE(UC_DESC,D);
IF NOT .STATUS THEN SIGNAL(.STATUS);

STATUS=LIB$LOOKUP_KEYWORD(UC_DESC,KTAB,FULL_VAL,FULL_D,FULL_LEN);
IF .STATUS EQL SS$_NORMAL AND .FULL_LEN EQL .KWS
  THEN	RETURN TRUE;

NEW_STRUC=.KTAB<31,1>;

STATUS=LIB$COLLECT_INITIALIZE(HANDLE);
IF NOT .STATUS THEN RETURN .STATUS;
SUB_COUNT=0;

LIB$SCAN_KEYWORD_TABLE(%REF(KTAB),UC_DESC,ACTION,KWS);

RETURN	LIB$COLLECT_OUTPUT(HANDLE,LIB$OUT_RECOG,CAB)

END;

GLOBAL ROUTINE LIB$$GENERAL_HELP(P_PAB) : NOVALUE =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Called in response to the HELP key applied to a keyword parameter.
!
! FORMAL PARAMETERS:
!
!	Address of CAB.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

BIND

	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	HLP	= .PAB[PAB$A_HLP]	: BLOCK[,BYTE],
	SOS	= .PAB[PAB$A_SOS]	: BLOCK[,BYTE];

LOCAL

	NAME;

NAME	= (IF HLP NEQ 0 AND .HLP[DSC$W_LENGTH] NEQ 0
		 THEN HLP
		 ELSE IF SOS NEQ 0
			THEN SOS
			ELSE %ASCID 'number');

$OUT(.NAME,HLP$K_HELP_LINE);
1
END;

GLOBAL ROUTINE LIB$$END_HELP(P_PAB) : NOVALUE =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Called in response to the HELP key applied
!	at the end of the line.
!
! FORMAL PARAMETERS:
!
!	Address of PAB.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

BIND

	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	HLP	= .PAB[PAB$A_HLP]	: BLOCK[,BYTE];

IF HLP EQL 0 OR .HLP[DSC$W_LENGTH] EQL 0
  THEN	$OUT(%ASCID 'confirm with carriage return',HLP$K_HELP_LINE)
  ELSE	$OUT(.PAB[PAB$A_HLP],HLP$K_HELP_LINE)

END;

GLOBAL ROUTINE LIB$OUT_RECOG(P_RECOG_DESC,P_CAB) : NOVALUE =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Actually outputs the recognized characters to the screen
!	and inserts them into the command line as if the user typed them.
!
! FORMAL PARAMETERS:
!
!	P_RECOG_DESC	Address of descriptor for recognized characters.
!
!	P_CAB		Address of CAB
!
! IMPLICIT INPUTS:
!
!	PTR
!
! IMPLICIT OUTPUTS:
!
!	PTR
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--

BIND

	CAB		= .P_CAB		: $CAB_DECL,
	RECOG_DESC	= .P_RECOG_DESC		: BLOCK[,BYTE],
	BUF		= .CAB[CAB$A_CBF]	: VECTOR[,BYTE],
	PTR		=  CAB[CAB$W_PTR]	: WORD,
	CLN		=  CAB[CAB$W_CLN]	: WORD;

LOCAL

	LC_FLAG,				! 1 if want to do recognition
						! in lower case.
	NEW_DESC	: VECTOR[2];

!+
!	Move the new characters into the command line.
!-

CH$MOVE(.RECOG_DESC[DSC$W_LENGTH],.RECOG_DESC[DSC$A_POINTER],BUF[.PTR]);
CLN=.CLN+.RECOG_DESC[DSC$W_LENGTH];

!+
!	Form a new descriptor for these characters, since
!	we don't want to violate the user's descriptor or data.
!-

NEW_DESC[0]=.RECOG_DESC[DSC$W_LENGTH];
NEW_DESC[1]=BUF[.PTR];

!+
!	Convert the recognized characters to lower case if the
!	"previous character" was lower case.
!	Actually we scan backwards looking for an alphabetic.
!	If this alphabetic was lower case, then we recognize
!	in lower case.  Space, tab, slash, and comma abort the scan.
!-

LC_FLAG=FALSE;
DECR I FROM .PTR-1 TO 0 DO
	SELECTONE .BUF[.I] OF
		SET
		['a' TO 'z']:	BEGIN
				LC_FLAG=TRUE;
				EXITLOOP
				END;

		['A' TO 'Z']:	EXITLOOP;

		[' ',9,'/',',']:EXITLOOP

		TES;
IF .LC_FLAG
  THEN	INCR I FROM .PTR TO .PTR+.NEW_DESC[0]-1 DO
		IF .BUF[.I] GEQU %C'A' AND .BUF[.I] LEQU %C'Z'
		  THEN	BUF[.I]=.BUF[.I]-%C'A'+%C'a';

!+
!	Output the recognized characters to the screen.
!-

$OUT(NEW_DESC,HLP$K_RECOG_LINE)

END;

GLOBAL ROUTINE LIB$$FILENAME_RECOG(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles recognition of RMS filenames.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB.
!
! IMPLICIT INPUTS:
!
!	PAB[PAB$L_ARG]		contains address of a vector of two longwords:
!
!					1.	address of descriptor
!						for default filespec
!					2.	address of related name block
!
!	PAB[PAB$A_CAB]		contains address of CAB
!
!	CAB[CAB$A_FLD_PTR]	Offset to start of partial filespecification
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	TRUE		complete recognition has been accomplished
!
!	FALSE		no recognition or partial recognition
!			has been accomplished.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

LOCAL

	RESCAN,
	PNS,
	PART_SIZE,
	STATUS;

BIND

	PAB		= .P_PAB		: $PAB_DECL,
	CAB		= .PAB[PAB$A_CAB]	: $CAB_DECL,
	PTR		=  CAB[CAB$W_PTR]	: WORD,
	VEC		= .PAB[PAB$L_ARG]	: VECTOR,
	BUF		= .CAB[CAB$A_CBF]	: VECTOR[,BYTE],
	INI		=  CAB[CAB$W_FLD_PTR]	: WORD;

OWN

	PRT		: VECTOR[NAM$C_MAXRSS,BYTE];

BIND

	PNM		=  BUF[.INI]			: VECTOR[,BYTE];

OWN

	QUOTE_COUNT,	! Number of quotes in user's filespecification
	NAM_SIZE;	! Number of characters in filename that user typed

!EXTERNAL ROUTINE
!
!	HLP$FAB_CLOSE_HANDLER;
!
!ENABLE	HLP$FAB_CLOSE_HANDLER(RECNIZ_FAB,DUMMY_RAB);

!+
!	Enter a default name into the FAB if the user specified one.
!-

RECNIZ_FAB[FAB$B_DNS]=0;
IF VEC NEQ 0
  THEN	IF .VEC[0] NEQ 0
	  THEN	BEGIN
		BIND DNM_DESC = .VEC[0] : BLOCK[,BYTE];
		RECNIZ_FAB[FAB$B_DNS]=.DNM_DESC[DSC$W_LENGTH];
		RECNIZ_FAB[FAB$L_DNA]=.DNM_DESC[DSC$A_POINTER]
		END;

!+
! Compute length of specified filespec.
!-

PNS=.PTR-.INI;
PART_SIZE = .PNS;
RELATE_NAM[NAM$B_RSL] = 0;

!+
! Scan the filespec backwards from the end, looking for special characters
! such as :, ", [, ], <, and >.
! The object of this search is to find the beginning of the filename
! part of the user's filespecification.
! Also, if we discover that we are inside an access control string,
! NODE"username password"::, or a remote node filespec, NODE::"filespec",
! then we can avoid trying to perform recognition.
! If we discover that we are inside a directory specification, [DIR],
! then we perform a different kind of recognition completely (temporarily
! not implemented).
! If we discover that we are inside a version number, then we temporarily
! perform no recognition.
!-

!+
! If there are an odd number of quotes in the user's filespecification,
! then we are in the middle of an access control string or
! foreign node filespec.  In that case, we perform no recognition.
!-

QUOTE_COUNT=0;
INCR SCAN_PTR FROM 0 TO .PNS-1 DO
	IF .PNM[.SCAN_PTR] EQL %C'"' THEN QUOTE_COUNT=.QUOTE_COUNT+1;
IF .QUOTE_COUNT THEN RETURN FALSE;

RESCAN=FALSE;
NAM_SIZE=0;
DECR SCAN_PTR FROM .PNS-1 TO 0 DO
	BEGIN
	SELECTONE .PNM[.SCAN_PTR] OF
	    SET

	    [%C':',%C']',%C'>']:

		EXITLOOP;

	    [%C'[',%C'<']:

		BEGIN
		LOCAL	DIR_STATUS;
		LOCAL	U_BUF	: VECTOR[NAM$C_MAXRSS,BYTE],
			U_DESC	: VECTOR[2],
			U_LEN;	! Can't bind this to U_DESC[0] because of side effects
		U_DESC[0]=NAM$C_MAXRSS;
		U_DESC[1]=U_BUF;

		!+
		! Go perform directory recognition on this partial
		! filespecification.
		!-

		DIR_STATUS=LIB$$DIRECTORY_RECOG(PAB,U_DESC,U_LEN);
		U_DESC[0]=.U_LEN;
		IF .U_DESC[0] NEQ 0
		  THEN	LIB$OUT_RECOG(U_DESC,CAB);

		!+
		! If no or only partial recognition has occurred,
		! then that's it for us.
		!-

		IF NOT .STATUS THEN RETURN .STATUS;

		RESCAN=TRUE;
		EXITLOOP;

		END;

	    [%C';']:

			;
!		IF .SCAN_PTR NEQ .PNS-1
!		  THEN	RETURN FALSE;	! not yet in

	    TES;

	NAM_SIZE=.NAM_SIZE+1
	END;

!+
! If directory recognition occurred, we have to rescan the
! updated specification.
!-

IF .RESCAN
  THEN	BEGIN
	PNS=.PTR-.INI;
	PART_SIZE=.PNS;
	NAM_SIZE=0;
	DECR SCAN_PTR FROM .PNS-1 TO 0 DO
		BEGIN
		SELECTONE .PNM[.SCAN_PTR] OF
			SET
			[%C':',%C']',%C'>']:	EXITLOOP;
			[%C'[',%C'<']:		RETURN FALSE;
!			[%C';']:		IF .SCAN_PTR NEQ .PNS-1
!						  THEN	RETURN FALSE;
			TES;
		NAM_SIZE=.NAM_SIZE+1
		END;
	END;

!+
! At this point, we have figured out how many characters
! are in the portion of the filename specified after the "]"
! that ends the directory name.  This is in NAM_SIZE.
! We now do a preliminary parse on the partial name so far.
! We will save a lot of computation if we find this is invalid.
! We also need to know if the filespec ends with a 9-character
! filename or a 3-character file type, because if so, we have to
! suppress appending the "*" to it in the next step, because
! of an RMS mis-feature. (RMS balks at a filespec of the form
! abcdefghi*.jkl or abc.def* because there appear to be too many
! characters, even though the "*" is permitted to match the null string.)
!-

RECNIZ_FAB[FAB$W_IFI] = 0;

RECNIZ_FAB[FAB$L_FNA]=BUF[.INI];
RECNIZ_FAB[FAB$B_FNS]=.PART_SIZE;
RECNIZ_FAB[FAB$L_NAM]=RECNIZ_NAM;

RECNIZ_NAM[NAM$B_ESS]=EXPAND_SIZ;
RECNIZ_NAM[NAM$L_ESA]=EXPAND_BUF;
RECNIZ_NAM[NAM$L_RLF]=0;

STATUS=$PARSE(FAB=RECNIZ_FAB);
IF NOT .STATUS THEN RETURN .STATUS;

!+
! If the preliminary parse was successful and we found any
! wildcards in the partial spec so far, then we want to
! "recognize" the expanded name but no do any lookups (searches).
! Also, if wildcards are prohibited in this field, then we
! clearly refuse to do recognition.
!-

IF .RECNIZ_NAM[NAM$V_WILDCARD] OR .RECNIZ_NAM[NAM$V_WILD_DIR]
  THEN	BEGIN

	LOCAL	D	: VECTOR[2];

	!+
	! Do no recognition if wildcards appear but are not permitted.
	!-

	IF .PAB[PAB$V_NOWLD]
	  THEN	RETURN FALSE;

	!+
	! Recognize the remainder of the expanded name.
	!-

	D[0]=.RECNIZ_NAM[NAM$B_NAME]
		+.RECNIZ_NAM[NAM$B_TYPE]
		+.RECNIZ_NAM[NAM$B_VER]
		-.NAM_SIZE;
	D[1]=.RECNIZ_NAM[NAM$L_NAME]+.NAM_SIZE;

	LIB$OUT_RECOG(D,CAB);

	RETURN SS$_NORMAL

	END;

!+
! Copy the partial filespecification to our own buffer,
! since we may have to modify it.
! (We typically add a "*" to the end which could be bad
! if the original buffer was too small.)
!-

CH$MOVE(.PART_SIZE,BUF[.INI],PRT);

!+
! Put a "*" at the end of the filespec.
! However, we omit this step if the partial specification
! ends with a nine-character filename or a 3-character filetype
! or a non-empty version number.  This is because RMS is unhappy
! with such specifications.
!-

IF .PRT[.PNS-1] EQL %C'.'
OR .PRT[.PNS-1] EQL %C';'
OR (.RECNIZ_NAM[NAM$B_NAME] NEQ 9 AND
   NOT (.RECNIZ_NAM[NAM$V_EXP_VER] OR .RECNIZ_NAM[NAM$V_EXP_TYPE]))
OR (.RECNIZ_NAM[NAM$B_TYPE] NEQ 4 AND
    .RECNIZ_NAM[NAM$V_EXP_TYPE]   AND
    NOT .RECNIZ_NAM[NAM$V_EXP_VER])
  THEN	BEGIN
	PRT[.PNS]=%C'*';
	PART_SIZE=.PART_SIZE+1;
	END;

!+
! Have to set the default file specification string.
! During recognition, the default file specification string
! that we use is built up from the user's default file
! specification string (DNM) by further applying the defaults "*.*;0".
! We do this via a preliminary call to $PARSE, using the same FAB.
! The desired new default filespecification is left in DFAULT_BUF.
!-

!CH$FILL(%C' ',DFAULT_SIZ,DFAULT_BUF);

!+
! In case we CTRL/C'ed out of a prior operation on this FAB
! and left the FAB open, we 0 out the IFI now.
! Herb jacobs assures me that even if there is an operation
! still pending on this FAB, when RMS completes it will
! notice that the FAB is no longer valid (IFI wrong) and will
! abort the operation.
!-

RECNIZ_FAB[FAB$W_IFI] = 0;

RECNIZ_FAB[FAB$L_FNA] = .RECNIZ_FAB[FAB$L_DNA];
RECNIZ_FAB[FAB$B_FNS] = .RECNIZ_FAB[FAB$B_DNS];
RECNIZ_FAB[FAB$L_DNA] = UPLIT('*.*;0');
RECNIZ_FAB[FAB$B_DNS] = %CHARCOUNT('*.*;0');
RECNIZ_FAB[FAB$L_NAM] = RECNIZ_NAM;
RECNIZ_NAM[NAM$L_ESA] = DFAULT_BUF;
RECNIZ_NAM[NAM$B_ESS] = DFAULT_SIZ;
RECNIZ_NAM[NAM$L_RLF] = 0;

STATUS=$PARSE(FAB=RECNIZ_FAB);
IF NOT .STATUS THEN RETURN FALSE;

RECNIZ_FAB[FAB$L_DNA] = .RECNIZ_NAM[NAM$L_ESA];
RECNIZ_FAB[FAB$B_DNS] = .RECNIZ_NAM[NAM$B_ESL];

!+
! Perform a $PARSE to set up the wildcard context.
!-

RECNIZ_FAB[FAB$L_FNA] =  PRT;
RECNIZ_FAB[FAB$B_FNS] = .PART_SIZE;

RECNIZ_NAM[NAM$L_ESA] = EXPAND_BUF;
RECNIZ_NAM[NAM$B_ESS] = EXPAND_SIZ;

STATUS=$PARSE(FAB=RECNIZ_FAB);
IF NOT .STATUS THEN RETURN .STATUS;

!+
! Perform a search.
!-

STATUS=LIB$COLLECT_INITIALIZE(HANDLE);
IF NOT .STATUS THEN RETURN .STATUS;

WHILE 1 DO
	BEGIN
	STATUS=$SEARCH(FAB=RECNIZ_FAB);
	SELECTONE .STATUS OF

	    SET

	    [RMS$_NORMAL]:

		BEGIN

		!+
		! We have now found a resultant string.
		!-

		RESULT_DESC[0]=.RECNIZ_NAM[NAM$B_RSL];

		!+
		! Make sure there is a 0 at the end of this buffer.
		!-

		RESULT_BUF[.RESULT_DESC[0]]=0;

		!+
		! Let us create a descriptor for the additional string
		! after the characters that the user has typed.
		! We count off characters forward from the final "]"
		! in the resultant string.
		!-

		DECR SCAN_PTR FROM .RESULT_DESC[0]-1 TO 0 DO
			IF .RESULT_BUF[.SCAN_PTR] EQL %C']'
			OR .RESULT_BUF[.SCAN_PTR] EQL %C'>'
			  THEN	BEGIN
				EXCESS_DESC[0]=
				    .RESULT_DESC[0]-.SCAN_PTR-1-.NAM_SIZE;
				EXCESS_DESC[1]=
				     RESULT_BUF[.SCAN_PTR+1+.NAM_SIZE];
				EXITLOOP
				END;
		STATUS=LIB$COLLECT_STORE(HANDLE,.EXCESS_DESC[0],.EXCESS_DESC[1]);
		IF NOT .STATUS THEN EXITLOOP
		END;

	    [RMS$_FNF]:

		EXITLOOP;

	    [RMS$_NMF]:

		EXITLOOP;

	    [OTHERWISE]:

		BEGIN
		LIB$COLLECT_ABORT(HANDLE);
		RETURN FALSE
		END

	    TES;

	END;

RETURN LIB$COLLECT_OUTPUT(HANDLE,LIB$OUT_RECOG,CAB)

END;

ROUTINE LIB$$DIRECTORY_RECOG(P_PAB,P_UNIQUE_DESC,P_UNIQUE_LEN) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles recognition of RMS input directory specifications.
!
!	These can include node names and device names.
!
!	The directory specification itself begins with either
!	a "[" or a "<" and may contain subdirectories
!	and initial "-" characters.  Wildcards, "*", "%", and "..."
!	are not permitted in an input specification.
!
! FORMAL PARAMETERS:
!
!	P_PAB			Address of PAB.
!
!	P_UNIQUE_DESC		Address of a string descriptor describing
!				the buffer to contain
!				the string of recognized characters.
!
!	P_UNIQUE_LEN		Address of a longword to receive the number
!				of characters recognized (may be 0).
!				Note that this value can't be 0 if full
!				recognition has succeeded because if the
!				user's string already ended with a "]" or ">",
!				then this routine would never have been called
!				in the first place.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	TRUE		complete recognition has been accomplished
!
!	FALSE		no recognition or partial recognition
!			has been accomplished.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

!+
! ALGORITHM:
!
!	Depending on the form of the directory portion of the partial
!	specification, we form a new directory specification including
!	wildcards (after prepending the original node name and device
!	name if any).  This new specification represents the directory
!	one level above the current one in the directory tree.
!	The derived specification is shown in the following examples:
!
!	User's partial
!	specification:		Derived specification:
!
!	[A			[000000]A*.DIR;1
!
!	[A.			[A]*.DIR;1
!
!	[A.B			[A]B*.DIR;1
!
!	[.			[]*.DIR;1
!
!	[.A			[]A*.DIR;1
!
!	[A.B.			[A.B]*.DIR;1
!
!	[A.B.C			[A.B]C*.DIR;1
!
!	[.A.			[.A]*.DIR;1
!
!	[.A.B			[.A]B*.DIR;1
!
!	[-			[-]*.DIR;1
!
!	[-.			[-]*.DIR;1
!
!	[-.A			[-]A*.DIR;1
!
!	[-.A.			[-.A]*.DIR;1
!
!	[-.A.B			[-.A]B*.DIR;1
!
!	[---.A.B.C.D		[---.A.B.C]D*.DIR;1
!
!	[A,			?
!
!	[A,B			?
!
! NOTE: We omit appending the "*" before a ".DIR;1" if the previous
!	name was already 9 characters long.
!
!-

BIND

	PAB		= .P_PAB			: $PAB_DECL,
	CAB		= .PAB[PAB$A_CAB]		: $CAB_DECL,
	PTR		=  CAB[CAB$W_PTR]		: WORD,
	INI		=  CAB[CAB$W_FLD_PTR]		: WORD,
	BUF		= .CAB[CAB$A_CBF]		: VECTOR[,BYTE],
	CLN		=  CAB[CAB$W_CLN]		: WORD,
	UNIQUE_DESC	= .P_UNIQUE_DESC		: VECTOR[2],
	UNIQUE_LEN	= .P_UNIQUE_LEN;

OWN

	DIRNIZ_FAB	: $FAB(NAM=RECNIZ_NAM) VOLATILE,
	END_NAME_LEN,	! Number of characters in trailing name of partial
			! specification.  For example, if the specification
			! were "DBA2:[ABC.EF", then END_NAME_LEN would
			! contain a 2 referring to the 2 characters "EF".
			! This value could be 0 if the partial specification
			! ended with a "-", ".", ",", "<", or "[".
	DELIM : BYTE,	! Delimiter preceding trailing name
	DELIM_PTR,	! Index within BUFFER where delimiter is located.
	BRACKET_PTR,	! Index within BUFFER where open bracket is located.
	LEFT_BRACKET  : BYTE,	! will contain either "[" or "<"
	RIGHT_BRACKET : BYTE;	! will contain matching "]" or ">".

LOCAL

	TEMP,
	STATUS;

OWN

	DERIVE_LEN,	! Number of characters in DERIVE_BUF
	DERIVE_BUF	: VECTOR[NAM$C_MAXRSS,BYTE],
	DERIVE_DESC	: VECTOR[2] INITIAL(NAM$C_MAXRSS,DERIVE_BUF),
	FIRST_FLAG,
	UNIQUE_PTR,
	NEW_COUNT,
	NEW_CHARS	: VECTOR[NAM$C_MAXRSS,BYTE],
	NEW_SIZE;

!EXTERNAL ROUTINE
!
!	HLP$FAB_CLOSE_HANDLER;
!
!ENABLE	HLP$FAB_CLOSE_HANDLER(DIRNIZ_FAB,DUMMY_RAB);

UNIQUE_LEN=0;

!+
!	Compute the number of characters in the trailing name of the
!	partial specification.  At the same time, find the character
!	that precedes this name.  The trailing name may only consist
!	of letters (A-Z, a-z), digits (0-9) and underscore (_).
!	The name length goes into END_NAME_LEN and the delimiter
!	gets stored in DELIM.  DELIM_PTR is updated to be the index
!	into BUFFER where this delimiter was stored.
!-

DELIM_PTR=-1;
DECR I FROM .CLN-1 TO .INI DO
	BEGIN
	SELECTONE .BUF[.I] OF	! This is slow - STAN -
	    SET
	    ['A' TO 'Z',
	     'a' TO 'z',
	     '0' TO '9','_']:	;
	    [OTHERWISE]:
		BEGIN
		DELIM=.BUF[.I];
		DELIM_PTR=.I;
		EXITLOOP
		END;
	    TES;
	END;

!+
! If an internal error occurs, namely no delimiter found,
! then no recognition is possible.  Don't signal this error,
! just beep the guy.  Most likely, the main parser will print
! a valid error message.
!-

IF .DELIM_PTR EQL -1 THEN RETURN FALSE;

END_NAME_LEN=.CLN-.DELIM_PTR-1;

!+
! Now continue to scan backwards looking for the initial "[" or "<".
! Whichever it is, store it in LEFT_BRACKET and store the matching
! type of right bracket in RIGHT_BRACKET.  We scan from the end instead of
! from the beginning so that we don't have to worry about ignoring
! brackets located within access control strings.
! If an internal error occurs, namely no open bracket found, then
! no recognition is possible.
! The index for where the open bracket was located in BUF is stored
! in BRACKET_PTR.  This may have the same value as DELIM_PTR if the
! delimiter was an open bracket.
!-

BRACKET_PTR=-1;

DECR I FROM .DELIM_PTR TO .INI DO
	SELECTONE .BUF[.I] OF

	    SET

	    [%C'[']:	BEGIN
			BRACKET_PTR	= .I;
			LEFT_BRACKET	= %C'[';
			RIGHT_BRACKET	= %C']';
			EXITLOOP
			END;

	    [%C'<']:	BEGIN
			BRACKET_PTR	= .I;
			LEFT_BRACKET	= %C'<';
			RIGHT_BRACKET	= %C'>';
			EXITLOOP
			END;

	    TES;

IF .BRACKET_PTR EQL -1 THEN RETURN FALSE;

!+
! If the delimiter found is not a nice one, then the user has
! typed an invalid partial directory specification or has attempted
! to use wildcards within an input filespec.
! However, it is not our duty to inform him of his error, we
! will merely beep him, and if he insists on typing carriage-return,
! then he will get a proper error message.
!-

!+
! We now go on to build the 'derived' specification for the parent
! directory from the user's partial directory specification.
! This derived specification will be built in DERIVE_BUF.
! First we copy the user's partial specification up to and including
! DELIM into DERIVE_BUF.
! Note that since DERIV_BUF is declared to be as long as the longest
! possible complete filespecification, we don't have to worry about
! checking for overflow when moving things into this buffer.
!-

DERIVE_LEN=.DELIM_PTR-.INI+1;
CH$MOVE(.DERIVE_LEN,BUF[.INI],DERIVE_BUF);

!+
! If the delimiter was ".", then replace the dot by the matching "]".
! If the delimiter was "-", then append a matching "]".
! If the delimiter was "[" or "<" then append "000000" followed
! by the matching close bracket.
!
! Set DERIVE_LEN to the number of characters now in DERIVE_BUF,
! i.e. it will be the index to the first free byte in DERIVE_BUF.
!-

SELECTONE .DELIM OF

    SET

    [%C'.']:

	BEGIN
	DERIVE_BUF[.DERIVE_LEN-1]=.RIGHT_BRACKET;
	END;

    [%C'[',%C'<']:

	BEGIN
	LITERAL	ZERO_LEN=%CHARCOUNT('000000');
	CH$MOVE(ZERO_LEN,UPLIT('000000'),DERIVE_BUF[.DERIVE_LEN]);
	DERIVE_BUF[.DERIVE_LEN+ZERO_LEN]=.RIGHT_BRACKET;
	DERIVE_LEN=.DERIVE_LEN+1+ZERO_LEN
	END;

    [%C'-']:

	BEGIN
	DERIVE_BUF[.DERIVE_LEN]=.RIGHT_BRACKET;
	DERIVE_LEN=.DERIVE_LEN+1
	END;

    [%C',']:

	RETURN FALSE;	! We don't yet handle [m,n] specifications

    [OTHERWISE]:

	RETURN FALSE

    TES;

!+
! Append the portion of the end-name that the user typed.
!-

CH$MOVE(.END_NAME_LEN,BUF[.DELIM_PTR+1],DERIVE_BUF[.DERIVE_LEN]);
DERIVE_LEN=.DERIVE_LEN+.END_NAME_LEN;

!+
! If the name already contains 9 characters, then no "*" is needed,
! otherwise, append a "*".
!-

IF .END_NAME_LEN NEQ 9
  THEN	BEGIN
	DERIVE_BUF[.DERIVE_LEN]=%C'*';
	DERIVE_LEN=.DERIVE_LEN+1
	END;

!+
! Finally, copy the string ".DIR.1" to the end of the derived-name buffer.
!-

TEMP=%CHARCOUNT('.DIR;1');
CH$MOVE(.TEMP,UPLIT('.DIR;1'),DERIVE_BUF[.DERIVE_LEN]);
DERIVE_LEN=.DERIVE_LEN+.TEMP;

DERIVE_DESC[0]=.DERIVE_LEN;

!+
! Zero out the IFI in case we had previously CTRL/C'ed out of
! this FAB leaving it invalid.
!-

DIRNIZ_FAB[FAB$W_IFI] = 0;

!+
! Perform a parse to set up for wild-card processing.
! In this case, there is no default name string or related name.
! If the parse fails, this is probably because of a syntax error
! on the user's part; however, this is no concern of ours - we
! merely refuse to do any recognition.
!-

DIRNIZ_FAB[FAB$B_DNS]=0;
RELATE_NAM[NAM$B_RSL]=0;
RECNIZ_NAM[NAM$B_RSL]=0;
DIRNIZ_FAB[FAB$L_FNA]= DERIVE_BUF;
DIRNIZ_FAB[FAB$B_FNS]=.DERIVE_LEN;

STATUS=$PARSE(FAB=DIRNIZ_FAB);
IF NOT .STATUS THEN RETURN FALSE;

!+
! If the derived filespec contains a wildcard in the directory
! portion, then no recognition is possible.
!-

IF .RECNIZ_NAM[NAM$V_WILD_DIR] THEN RETURN FALSE;

!+
! Perform a search.
!-

FIRST_FLAG=TRUE;
NEW_COUNT=0;
WHILE 1 DO
	BEGIN
	STATUS=$SEARCH(FAB=DIRNIZ_FAB);
	SELECTONE .STATUS OF

	    SET

	    [RMS$_NORMAL]:

		BEGIN
		!+
		! We have now found a resultant string.
		!-
		RESULT_DESC[0]=.RECNIZ_NAM[NAM$B_RSL];
		!+
		! Make sure there is a 0 at the end of this buffer.
		!-
		RESULT_BUF[.RESULT_DESC[0]]=0;
		!+
		! Let us create a descriptor for the additional string
		! after the characters that the user has typed.
		! We count off characters forward from the final "]"
		! in the resultant string.
		!-
		DECR SCAN_PTR FROM .RESULT_DESC[0]-1 TO 0 DO
			IF .RESULT_BUF[.SCAN_PTR] EQL .RIGHT_BRACKET
			  THEN	BEGIN
				UNIQUE_LEN=
				    .RESULT_DESC[0]-.SCAN_PTR-1-.END_NAME_LEN
				    -%CHARCOUNT('.DIR;1');
				UNIQUE_PTR=
				     RESULT_BUF[.SCAN_PTR+1+.END_NAME_LEN];
				EXITLOOP
				END;
		NEW_COUNT=.NEW_COUNT+1;
		!+
		! Calculate the number of additional characters
		! in this resultant string.
		!-
		IF .FIRST_FLAG
		  THEN	BEGIN
			NEW_SIZE=.UNIQUE_LEN;
			CH$MOVE(.NEW_SIZE,.UNIQUE_PTR,NEW_CHARS);
			FIRST_FLAG=FALSE
			END
		  ELSE	BEGIN
			BIND	XS_BUF = .UNIQUE_PTR : VECTOR[,BYTE];
			!+
			! Don't bother getting more filenames if NEW_SIZE
			! is already 0.
			!-
			IF .NEW_SIZE EQL 0 THEN EXITLOOP;
			!+
			! Find out how many characters match previous excess list.
			!-
			INCR I FROM 0 TO .NEW_SIZE-1 DO
				IF .NEW_CHARS[.I] NEQ .XS_BUF[.I]
				  THEN	BEGIN
					NEW_SIZE=.I;
					EXITLOOP
					END;
			END;
		END;

	    [RMS$_FNF]:

		EXITLOOP;

	    [RMS$_NMF]:

		EXITLOOP;

	    [OTHERWISE]:

		IF NOT .STATUS THEN RETURN FALSE

	    TES;

	END;

IF .NEW_COUNT EQL 0 THEN RETURN FALSE;

IF .NEW_COUNT EQL 1
  THEN	BEGIN
	LOCAL TEMP;
	!+
	! We have completely recognized a directory (or subdirectory) name.
	! Now we have to decide whether to beep or recognize a "]".
	! We take the name so far, add a "]*.DIR;1", and do another
	! parse and search to see if there are any more subdirectories.
	! If there are, then we beep the user (return a partial recognition
	! indication) since the user could mean the current directory or one
	! of its subdirectories.  If there are no further subdirectories,
	! then we recognize a close bracket and exit having performed
	! complete recognition on the directory component of
	! the filespecification.
	!-

	!+
	! Move the name so far into DERIVE_BUF.
	!-

	CH$MOVE(.CLN-.INI,BUF[.INI],DERIVE_BUF);
	CH$MOVE(.NEW_SIZE,NEW_CHARS,DERIVE_BUF[.CLN-.INI]);
	DERIVE_LEN=.CLN-.INI+.NEW_SIZE;
	DERIVE_BUF[.DERIVE_LEN]=.RIGHT_BRACKET;
	DERIVE_LEN=.DERIVE_LEN+1;
	TEMP=%CHARCOUNT('*.DIR;1');
	CH$MOVE(.TEMP,UPLIT('*.DIR;1'),DERIVE_BUF[.DERIVE_LEN]);
	DERIVE_LEN=.DERIVE_LEN+.TEMP;

	!+
	! Perform a PARSE to get ready for doing a SEARCH.
	!-

	DIRNIZ_FAB[FAB$L_FNA]= DERIVE_BUF;
	DIRNIZ_FAB[FAB$B_FNS]=.DERIVE_LEN;
	STATUS=$PARSE(FAB=DIRNIZ_FAB);
	IF NOT .STATUS
	  THEN	NEW_COUNT=2	! Anything but 1 stops full recognition
	  ELSE	BEGIN
		!+
		! Now do a SEARCH.
		!-
		STATUS=$SEARCH(FAB=DIRNIZ_FAB);
		IF NOT .STATUS
		  THEN	BEGIN
			NEW_CHARS[.NEW_SIZE]=.RIGHT_BRACKET;
			NEW_SIZE=.NEW_SIZE+1;
			END
		  ELSE	NEW_COUNT=2;
		END;
	END;

UNIQUE_LEN=MIN(.NEW_SIZE,.UNIQUE_DESC[0]);
CH$MOVE(.UNIQUE_LEN,NEW_CHARS,.UNIQUE_DESC[1]);

RETURN (.NEW_COUNT EQL 1)

END;

GLOBAL ROUTINE LIB$$NUMBER_RECOG(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles recognition of a number.
!	If we are at the beginning of the field, then
!	we recognize the default (if any).
!	Otherwise, we merely ascertain that the field is a
!	syntactically valid number and assume that it is complete.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB.
!
! IMPLICIT INPUTS:
!
!	USER[USER$L_RECOGNIZE_ARG]	Default value (unsigned)
!					-1 means no default.
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	TRUE		Field was syntactically valid; complete
!			recognition has therefore occurred
!
!	FALSE		We are at beginning of field and there is
!			no default.  No recognition is possible.
!					OR
!			Field was invalid; contained a non-digit.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

BIND

	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	INI	=  CAB[CAB$W_FLD_PTR]	: WORD,
	PTR	=  CAB[CAB$W_PTR]	: VOLATILE WORD,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE],
	RADIX	=  PAB[PAB$L_ARG]	: LONG;

LOCAL

	RAD,
	MAX_DIG,
	STATUS;

IF .RADIX NEQ 16
  THEN	RAD=MAX(.RADIX,10);

IF .RADIX LSS 2
  THEN	RAD=10;

MAX_DIG=%C'0'+.RAD-1;

!+
! We verify that the field has been properly filled in
! with digits only.  If the field is syntactically correct,
! then we assume that the user has finished typing in his number
! and we say that complete recognition ahs taken place.
! If the field is syntactically in error, then we beep the guy.
!-

IF .RADIX EQL 16
  THEN	INCR P FROM .INI TO .PTR-1 DO
		BEGIN
		IF (.BUF[.P] GEQU %C'0' AND .BUF[.P] LEQU %C'9')
		OR (.BUF[.P] GEQU %C'A' AND .BUF[.P] LEQU %C'F')
		OR (.BUF[.P] GEQU %C'a' AND .BUF[.P] LEQU %C'f')
		  THEN	1
		  ELSE	RETURN FALSE
		END
  ELSE	INCR P FROM .INI TO .PTR-1 DO
		IF .BUF[.P] LSS %C'0' OR .BUF[.P] GTR .MAX_DIG
		  THEN	RETURN FALSE;

!+
! There must be at least one digit.
!-

RETURN (.INI NEQ .PTR)

END;

GLOBAL ROUTINE LIB$$TOKEN_RECOG(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles recognition of a token.
!	We ascertain that the field is exactly the string specified.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB.
!
! IMPLICIT INPUTS:
!
!	PAB[PAB$L_ARG]	Address of descriptor for the token.
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	TRUE		Field was syntactically valid; complete
!			recognition has therefore occurred
!
!	FALSE		We are at beginning of field and there is
!			no default.  No recognition is possible.
!					OR
!			Field was invalid; contained a non-digit.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

BIND

	PAB	= .P_PAB		: $PAB_DECL,
	CAB	= .PAB[PAB$A_CAB]	: $CAB_DECL,
	INI	=  CAB[CAB$W_FLD_PTR]	: WORD,
	PTR	=  CAB[CAB$W_PTR]	: VOLATILE WORD,
	BUF	= .CAB[CAB$A_CBF]	: VECTOR[,BYTE],
	TOK	= .PAB[PAB$L_ARG]	: BLOCK[,BYTE],
	TOKLEN	=  TOK[DSC$W_LENGTH]	: WORD,
	TOKBUF	= .TOK[DSC$A_POINTER]	: VECTOR[,BYTE];

LOCAL

	D		: VECTOR[2],
	PART_SIZ,
	STATUS;

!+
!	We look at the characters already typed in by the user.
!	They must match exactly with the characters specified.
!	If not, we return FALSE, indicating that we cannot
!	perform recognition.  If they are correct, then we
!	can recognize the remainder of the token.
!-

PART_SIZ=.PTR-.INI;
STATUS=CH$EQL(.PART_SIZ,BUF[.INI],.PART_SIZ,TOKBUF,0);
IF NOT .STATUS THEN RETURN .STATUS;

!+
! We now recognize the remainder of the token.
!-

IF .TOKLEN GTRU .PART_SIZ
  THEN	BEGIN
	D[0]=.TOKLEN-.PART_SIZ;
	D[1]=TOKBUF[.PART_SIZ];
	LIB$OUT_RECOG(D,CAB)
	END;

RETURN SS$_NORMAL

END;

GLOBAL ROUTINE LIB$$NO_RECOG(P_PAB) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles recognition for items that don't do recognition.
!
! FORMAL PARAMETERS:
!
!	P_PAB		Address of PAB.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	FALSE		We are at beginning of field and there is
!			no default.  No recognition is possible.
!					OR
!			Field was invalid; contained a non-digit.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

RETURN FALSE

END;

ROUTINE RECOG_DOCUMENT(DOC_FLAG) =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Handles recognition of DECset document and segment names.
!
! FORMAL PARAMETERS:
!
!	DOC_FLAG		TRUE means we should try to recognize
!				a segment name, if can't, then try a
!				document name.
!				FALSE means we must be looking for
!				a segment name only.
!
! IMPLICIT INPUTS:
!
!	CMD[CMD$W_INI_PTR]	Index to start of document specification.
!
!	PTR			Index to first character after document
!				specification.
!
!	BUF			Address of buffer containing command line.
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	TRUE		complete recognition has been accomplished
!
!	FALSE		no recognition or partial recognition
!			has been accomplished.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

!$SCP_INIT(STRUC=<CMD,USER,PIT,DAT>);
LOCAL PTR;

!BIND
!
!	PTR	=	PIT[PIT$W_CMD_LINE_PTR]	: VOLATILE WORD,
!	DEFAULT_DOC	= DAT[DAT$CS_DOCUMENT]	: $COUNTED_STRING;

LOCAL

	STATUS;

!+
! Go look up segment names.
!-

!+
! If there is no default document yet, then this name
! must be a document name.
!-

!IF .DEFAULT_DOC[CS$B_LENGTH] EQL 0 AND .DOC_FLAG
!  THEN	STATUS=WILD$K_NONE
!  ELSE	STATUS=HLP$WILDMAN(SDM$FT_SNAME);

SELECTONE .STATUS OF

    SET

    [WILD$K_FULL]:

	! Have performed complete recognition on a segment name.

	RETURN TRUE;

    [WILD$K_SOME]:

	! Have performed partial recognition of a segment name.

	RETURN FALSE;

    [WILD$K_NONE]:

	! No segments by this name.
	! Perhaps it was a document name instead.

	IF .DOC_FLAG
	  THEN	BEGIN

		!+
		! Go look up document names.
		!-

!		STATUS=HLP$WILDMAN(SDM$FT_DNAME);
		SELECTONE .STATUS OF

		    SET

		    [WILD$K_FULL]:

			! Have performed complete recognition of a document name.

			BEGIN
			LIB$OUT_RECOG(%ASCID ':');
			RETURN TRUE
			END;

		    [WILD$K_SOME,WILD$K_NONE]:

			! Have performed little or no recognition.

			RETURN FALSE;

		    TES;

		END

    TES;

RETURN FALSE

END;

GLOBAL ROUTINE LIB$$BREAK_RECOG : NOVALUE =

BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	prevents multiple field recognition from
!	continuing past this point.
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	BUF[.PTR]	current character.
!			If this is HLP$K_DELIM, then multiple field
!			recognition is in progress.
!
! IMPLICIT OUTPUTS:
!
!	USER[USER$L_INI_DATA_LEN]	\  Gets length and pointer to
!	USER[USER$L_INI_DATA_PTR]	/  new initial string.
!
! ROUTINE VALUE:
!
!	NONE
!
!	NOTE:	Routine may not return if multiple field recognition
!		was in progress.  If that is the case, the REPARSE
!		condtion is resignalled and the stack is unwound.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

!$SCP_INIT(STRUC=<USER,PIT>);
!BIND	PTR	=	PIT[PIT$W_CMD_LINE_PTR]	: VOLATILE WORD;
LOCAL PTR;

!IF .BUF[.PTR] EQL HLP$K_DELIM
!  THEN	BEGIN
!	USER[USER$L_INI_DATA_LEN] = .PTR;
!	USER[USER$L_INI_DATA_PTR] = BUF;
!	HLP$RESTORE_STATE();
!	SIGNAL(HLP$_REPARSE)
!	END;
1

END;

END
ELUDOM