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) 1981, 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:
!
!	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