Trailing-Edge
-
PDP-10 Archives
-
BB-H138F-BM_1988
-
7-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) 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 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