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

 %TITLE 'CHMONSTR - test for being on a given string'
MODULE CHMONSTR (				! Test for being on a given string
		IDENT = '3-005'			! File: CHMONSTR.BLI Edit: CJG3005
		) =
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:
!
!	This module determines if the current position matches
!	a given string.
!
! ENVIRONMENT:	Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: Unknown
!
! MODIFIED BY:
!
! 1-001	- Original.  DJS 04-Feb-1981.  This module was created by
!	extracting the routine EDT$$TST_ONSTR  from module CHANGE.BLI.
! 1-002	- Regularize headers.  JBS 03-Mar-1981
! 1-003 - Add WPS string matching.  STS 05-Oct-1981
! 1-004	- Support the DEC Multinational character set.  JBS 20-Jul-1982
! 1-005 - Replace call to edt$$tst_eob. STS 22-Sep-1982
! 1-006	- Fix a missing dot.  JBS 07-Dec-1982
! 1-007	- Add conditionals for WPS and VT220 support.  JBS 11-Feb-1983
! 3-001 - Make CP a real pointer and fix some quoted characters.  GB 24-Mar-1983
! 3-002 - Add updates from V3 source kit.  GB 28-Apr-1983
! 3-003 - Modified to support SET SEARCH IGNORE. CJG 17-Nov-1983
! 3-004 - Remove VT220 conditional to speed up code. CJG 25-Nov-1983
! 3-005 - Modify ASSERT macro to include error code. CJG 30-Jan-1984
!--

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

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$TST_ONSTR;			! Compare the current character position with a string descriptor

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

LIBRARY 'EDTSRC:TRANSLATE';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!
!	NONE
!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!
!	In the routine
%SBTTL 'EDT$$TST_ONSTR  - test for being on a given string'

GLOBAL ROUTINE EDT$$TST_ONSTR (			! Test for being on a given string
	ADDR, 					! Address of the model string
	LEN					! Length of the model string
    ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine checks to see if the string specified by ADDR and
!	LEN matches at the current character position.
!
! FORMAL PARAMETERS:
!
!  ADDR			Address of the string to test against the current position
!
!  LEN			Length of that string
!
! IMPLICIT INPUTS:
!
!	EXCT_MATCH
!	LN_END
!	LN_PTR
!
! IMPLICIT OUTPUTS:
!
!	LN_PTR
!
! ROUTINE VALUE:
!
!	The value 1 is returned if it matches, 0 otherwise.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    EXTERNAL ROUTINE
	EDT$$CS_DWN,			! Move down a line
	EDT$$CS_LEFT;			! Move left a character

    EXTERNAL
	WK_LN : REF LIN_BLOCK,
	EOB_LN,
	IGN_LEN,			! Length of ignore string
	IGN_PTR,			! Pointer to ignore string
	EXCT_MATCH,			! Exact search or no.
	LN_END,				! End of current line pointer
	LN_PTR,				! Current character pointer
	CHAR_INFO : BLOCKVECTOR [256, 1];	! Information about characters

    BIND
	GENERAL_TABLE = UPLIT (CHAR_GENERAL_TAB) : VECTOR [256];

    BIND
	CI_TABLE = UPLIT (CHAR_CI_TAB) : VECTOR [256];

    BIND
	DI_TABLE = UPLIT (CHAR_DI_TAB) : VECTOR [256];

    LOCAL
	SC,
	TC,
	CP,
	SKIPPED,
	IGNORED,
	MATCHED;

!+
! Keep track of how many characters matched so we can back up.
!-
    SKIPPED = 0;
    IGNORED = 0;
    MATCHED = 0;
    CP = CH$PTR (.ADDR,, BYTE_SIZE);
!+
! Loop over size of the string.
!-

    DECR I FROM .LEN - 1 TO 0 DO
	BEGIN

	IF CH$PTR_EQL (.LN_PTR, .LN_END)
	THEN

	    IF (CH$RCHAR_A (CP) EQL ASC_K_CR)
	    THEN

		IF (.WK_LN EQLA EOB_LN) THEN EXITLOOP ELSE EDT$$CS_DWN ()

	    ELSE
		EXITLOOP

	ELSE
	    BEGIN
	    IF ((.IGN_LEN EQL 0) OR (.EXCT_MATCH NEQ 0))
	    THEN
		BEGIN
		SC = CH$RCHAR (.LN_PTR);
		TC = CH$RCHAR_A (CP);		! get the char we're trying to match
		END
	    ELSE
		BEGIN
		WHILE 1 DO
		    BEGIN
		    SC = CH$RCHAR (.LN_PTR);
		    IF CH$FAIL (CH$FIND_CH (.IGN_LEN, .IGN_PTR, .SC)) THEN EXITLOOP;
		    LN_PTR = CH$PLUS (.LN_PTR, 1);
		    SKIPPED = .SKIPPED + 1;
		    END;
		WHILE 1 DO
		    BEGIN
		    TC = CH$RCHAR_A (CP);
		    IF CH$FAIL (CH$FIND_CH (.IGN_LEN, .IGN_PTR, .TC)) THEN EXITLOOP;
		    IGNORED = .IGNORED + 1;
		    END;
		END;

	    CASE .EXCT_MATCH FROM 0 TO 4 OF
		SET

		[0] : 				! General

		    IF (.GENERAL_TABLE [.SC] NEQ .GENERAL_TABLE [.TC]) THEN EXITLOOP;

		[1] : 				! Exact

		    IF (.SC NEQ .TC) THEN EXITLOOP;

		[2] : 				! WPS
		    BEGIN

		    IF .CHAR_INFO [.TC, CI_LC]	! If lower case letter
		    THEN
			BEGIN
			IF (.CI_TABLE [.SC] NEQ .CI_TABLE [.TC]) THEN EXITLOOP;
			END
		    ELSE
			BEGIN
			IF (.SC NEQ .TC) THEN EXITLOOP;	! Exact compare
			END;

		    END;

		[3] : 				! Case insensitive

		    IF (.CI_TABLE [.SC] NEQ .CI_TABLE [.TC]) THEN EXITLOOP;

		[4] : 				! Diacritical insensitive

		    IF (.DI_TABLE [.SC] NEQ .DI_TABLE [.TC]) THEN EXITLOOP;

		[OUTRANGE] :

		    ASSERT (3, 0);

		TES;

	    LN_PTR = CH$PLUS (.LN_PTR, 1);
	    END;

	MATCHED = .MATCHED + 1;
	END;

!+
! Back up to the original position.
!-

    DECR I FROM (.MATCHED + .SKIPPED - 1) TO 0 DO
	EDT$$CS_LEFT ();

    RETURN ((.MATCHED + .IGNORED) EQL .LEN);
    END;					! of routine EDT$$TST_ONSTR

!<BLF/PAGE>

END						! of module EDT$CHMONSTR
ELUDOM