Google
 

Trailing-Edge - PDP-10 Archives - bb-r775c-bm_tops20_ks_upd_3 - sources/chmfinstr.bli
There are 11 other files named chmfinstr.bli in the archive. Click here to see a list.
 %TITLE 'CHMFINSTR - search for a specific string'
MODULE CHMFINSTR (				! Search for a specific string
		IDENT = '3-002'			! File: CHMFINSTR.BLI Edit: CJG3002
		) =
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 searches text for a specific 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$$STR_SEACMD  from module CHANGE.BLI.
! 1-002	- Regularized headers.  JBS 27-Feb-1981
! 1-003	- Fix module name.  JBS 02-Mar-1981
! 1-004 - Change return value on backwards search with search end set.  SMB 27-Oct-1981
! 1-005	- Set a flag if control C actually aborts something.  JBS 24-May-1982
! 1-006 - Return a zero if string not found.  SMB 17-Aug-1982
! 1-007	- Remove EDT$$G_LN_NO for new screen update logic.  JBS 29-Sep-1982
! 3-001 - Change handling of page entity and make CP a real pointer.  GB 24-Mar-1983
! 3-002 - Fix second call to EDT$$TST_ONSTR so that SET SEARCH BOUNDED works.
!	  CJG 16-Dec-1983
!--

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

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$STR_SEACMD;				! Search for a specific string

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!
!	NONE
!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!
!	In the routine
%SBTTL 'EDT$$STR_SEACMD  - search for a specific string'

GLOBAL ROUTINE EDT$$STR_SEACMD (		! Search for a specific string
    ADDR, 					! address of the model string
    LEN, 					! model string's length
    M, 						! move a character before beginning
    DIR						! direction of the search
    ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine searches either forward or backward from the current
!	position looking for a specific string.
!
! FORMAL PARAMETERS:
!
!  ADDR 		the address of the string to find
!  LEN 			the length of the string
!  M 			indicates whether or not we should move a character before beginning.
!  DIR 			the direction of the search.
!
! IMPLICIT INPUTS:
!
!	US_ENT
!	SEA_BEG
!	SEA_BNDD
!	LN_BUF
!	LN_PTR
!	LN_END
!
! IMPLICIT OUTPUTS:
!
!	CUR_BUF
!	LN_PTR
!	CC_DONE
!
! ROUTINE VALUE:
!
!	1 is returned if the string is found, 0 if not, 2 if search aborted by control C.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    EXTERNAL ROUTINE
	EDT$$CHK_CC,				! Check to see if a CTRL/C has been typed
	EDT$$GET_TXTLN,				! Get current line in line buffer
	EDT$$CS_LEFT,				! Move left a character
	EDT$$CS_RIGHT,				! Move right a character
	EDT$$CS_UP,				! Move up a line
	EDT$$TST_ONSTR,			! Compare the current character position with a string descriptor
	EDT$$RPOS : NOVALUE,			! Restore the saved buffer position
	EDT$$SAV_BUFPOS : NOVALUE,		! Save the current buffer position
	EDT$$STR_SEA,
	CC_DONE;				! Set to 1 if control C actually aborts something

    EXTERNAL
	US_ENT : VECTOR,			! Pointers to user defined entities
	SEA_BEG,				! Leave search at begining if on
	SEA_BNDD,			! Is search bounded.
	CUR_BUF : REF TBCB_BLOCK,	! The current buffer tbcb
	LN_BUF,				! Current line buffer
	LN_PTR,				! Current character pointer
	LN_END;				! End of current line pointer

    LABEL
	SEARCH_LOOP;

    LOCAL
	MOVE,
	INIT_LEN,
	CP,
	C,
	START_POS : POS_BLOCK,
	STS;

    MOVE = .M;
!+
! Remember where we started.
!-
    EDT$$SAV_BUFPOS (START_POS);
!+
! If searching backward, with search at end, move length of search string back
! before starting, so we won't keep finding the same string!  Also, if searching
! forward with search at end, do not move before starting search.
!-

    IF (.SEA_BEG EQL 0)
    THEN

	IF (.DIR EQL DIR_BACKWARD)
	THEN
	    BEGIN

	    INCR I FROM 1 TO .LEN DO

		IF ( NOT EDT$$CS_LEFT ())
		THEN
		    BEGIN
!+
! If cursor-position minus buffer-begin-position is less than length of
! search string, then search automatically fails.  Reposition cursor
! and return not found.
!-
		    EDT$$RPOS (START_POS);
		    RETURN (0);
		    END;

	    END
	ELSE
	    MOVE = 0;

!+
! Find the prefix of the search string up to the first carriage return.
!-
    INIT_LEN = 0;
    CP = CH$PTR (.ADDR,, BYTE_SIZE);

    WHILE ((.INIT_LEN LSS .LEN) AND CH$RCHAR_A (CP) NEQ ASC_K_CR) DO
	INIT_LEN = .INIT_LEN + 1;

!+
! Now, look for the string.
!-
    STS = 0;
SEARCH_LOOP :
    BEGIN

    WHILE 1 DO
	BEGIN

	IF EDT$$CHK_CC ()
	THEN
	    BEGIN
	    STS = 2;
	    CC_DONE = 1;
	    EXITLOOP;
	    END;

	IF .MOVE
	THEN

	    IF ((IF .DIR EQL DIR_BACKWARD THEN EDT$$CS_LEFT () ELSE EDT$$CS_RIGHT ()) EQL 0) THEN EXITLOOP;

	MOVE = 1;
!+
! Find next occurrence of the initial string.
!-

	IF (.SEA_BNDD EQL 0)
	THEN

	    IF (.INIT_LEN NEQ 0)
	    THEN
		BEGIN
		CUR_BUF [TBCB_CHAR_POS] = CH$DIFF (.LN_PTR, CH$PTR (LN_BUF,, BYTE_SIZE));

		IF ( NOT (STS = EDT$$STR_SEA (CH$PTR (.ADDR,, BYTE_SIZE),
			.INIT_LEN, .DIR))) THEN EXITLOOP;

		EDT$$GET_TXTLN ();
		END
	    ELSE
!+
! Look for the next carriage return.
!-

		WHILE (CH$RCHAR (.LN_PTR) NEQ ASC_K_CR) DO

		    IF (.DIR EQL DIR_BACKWARD)
		    THEN

			IF CH$PTR_EQL (.LN_PTR, CH$PTR (LN_BUF,, BYTE_SIZE))
			THEN

			    IF EDT$$CS_UP () THEN LN_PTR = .LN_END ELSE LEAVE SEARCH_LOOP

			ELSE
			    LN_PTR = CH$PLUS (.LN_PTR, -1)

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

!+
! Now check to see if the entire string matches.
!-

	IF EDT$$TST_ONSTR (.ADDR, .LEN)
	THEN
!+
! If we have gotten here, the string matched.
!-
	    RETURN (1)
	ELSE
	    STS = 0;

!+
! If search is bounded, fail if we are on a page mark.
!-

	IF (.SEA_BNDD NEQ 0)
	THEN

	    IF EDT$$TST_ONSTR (.US_ENT [3] + 1, ..US_ENT [3]) THEN EXITLOOP;

	END;

    END;
!+
! String was not found, reposition.
!-
    EDT$$RPOS (START_POS);
    RETURN (.STS);
    END;					! of routine EDT$$STR_SEACMD


END
ELUDOM