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