-- TextFind2Impl.Mesa
-- last written by Paxton, February 24, 1983 9:54 am
DIRECTORY
TextFind,
TextFindPrivate,
TextLooks,
TextLooksSupport,
TextEdit,
TextNode,
RopeEdit,
Rope,
RopeReader,
RunReader,
LooksReader,
Inline;
TextFind2Impl: CEDAR PROGRAM
IMPORTS TextFindPrivate, TextEdit, TextLooksSupport,
LooksReader, RopeEdit, RopeReader, RunReader, Rope, Inline
EXPORTS TextFind, TextFindPrivate =
BEGIN OPEN TextFind, TextFindPrivate, RopeEdit;
Finder: TYPE = REF FinderRec;
FinderRec: PUBLIC TYPE = FinderRecord;
-- ***** Operations *****
noMoreChars: SIGNAL = CODE; -- for use in Try
SearchRope: PUBLIC PROC [finder: Finder, rope: Rope.ROPE,
start: Offset ← 0, len: Offset ← MaxLen, interrupt: REF BOOLNIL]
RETURNS [found: BOOLEAN, at, atEnd, before, after: Offset] = {
[found, at, atEnd, before, after] ← Search[finder, rope, NIL, start, len, FALSE, interrupt] };
Try: PUBLIC PROC [finder: Finder, text: RefTextNode,
start: Offset ← 0, len: Offset ← MaxLen,
looksExact: BOOLEANFALSE, interrupt: REF BOOLNIL]
RETURNS [found: BOOLEAN, at, atEnd, before, after: Offset] = {
[found, at, atEnd, before, after] ← Search[
finder, TextEdit.GetRope[text], TextEdit.GetRuns[text], start, len, looksExact, interrupt] };
Search: PROC [finder: Finder, rope: ROPE, runs: TextLooks.Runs,
start: Offset, len: Offset, looksExact: BOOLEAN, interrupt: REF BOOLNIL]
RETURNS [found: BOOLEAN, at, atEnd, before, after: Offset] = {
IF finder.wordSearch THEN DO -- repeat search until find a word
[found, at, atEnd, before, after] ← TryToFind[finder, rope, runs, start, len, looksExact];
IF ~found OR (interrupt#NIL AND interrupt^) THEN RETURN; -- failed
IF IsWord[rope, at, atEnd] THEN RETURN; -- got it
start ← after; -- try again
ENDLOOP;
[found, at, atEnd, before, after] ←
TryToFind[finder, rope, runs, start, len, looksExact, interrupt] };
IsWord: PUBLIC PROC [rope: ROPE, at, atEnd: Offset] RETURNS [BOOLEAN] = {
IF at > 0 AND
GetCharProp[Rope.Fetch[rope,at-1]] = alphaNumeric THEN RETURN [FALSE];
IF atEnd < Rope.Size[rope] AND
GetCharProp[Rope.Fetch[rope,atEnd]] = alphaNumeric THEN RETURN [FALSE];
RETURN [TRUE];
};
TryToFind: PROC [
finder: Finder, rope: ROPE, runs: TextLooks.Runs,
start: Offset ← 0, len: Offset ← MaxLen, looksExact: BOOLEANFALSE,
interrupt: REF BOOLNIL]
RETURNS [found: BOOLEAN, at, atEnd, before, after: Offset] = { OPEN finder;
stackPtr, patternPos, patternAnchor: NAT ← 0;
char, patternChar: CHAR ← 377C;
charType: CharProperty;
beginPos, endPos, textPos, textAnchor, end, size: Offset;
psLength: NAT;
LooksMatch: PROC [txtpos: Offset, ppos: NAT] RETURNS [BOOLEAN] = {
patlks, sourcelks: TextLooks.Looks;
IF (patlks ← patternLooks[ppos]) = TextLooks.noLooks THEN RETURN [TRUE];
IF runs=NIL THEN RETURN [FALSE]; -- pattern has looks and text doesn't
IF txtpos NOT IN [start..end) THEN RETURN [FALSE]; -- boundary char has no looks
LooksReader.SetPosition[lksReader,runs,txtpos];
sourcelks ← LooksReader.Get[lksReader];
RETURN [patlks=(IF looksExact THEN sourcelks ELSE TextLooksSupport.LooksAND[sourcelks,patlks])] };
GetChar: PROC [txtpos: Offset] RETURNS [char: CHAR] = {
SELECT txtpos FROM
IN [start..end) => { -- read the character from the rope
RopeReader.SetPosition[ropeReader,rope,txtpos]; char ← RopeReader.Get[ropeReader] };
ENDCASE => SIGNAL noMoreChars }; -- failure return; have run out of characters
PropTest: TYPE = { eq, ne, any };
MaxCount: PROC [propTest: PropTest, property: CharProperty ← illegal]
RETURNS [count: INT] = {
count ← 0;
DO
char ← GetChar[textPos+count ! noMoreChars => EXIT];
IF propTest=eq THEN IF GetCharProp[char] # property THEN EXIT ELSE NULL
ELSE IF propTest=ne AND GetCharProp[char]=property THEN EXIT ELSE NULL;
IF patternLooks # NIL AND patternLooks[patternPos] # TextLooks.noLooks
AND ~LooksMatch[textPos+count, patternPos] THEN EXIT;
count ← count+1;
ENDLOOP;
};
size ← Rope.Size[rope];
start ← MIN[MAX[0,start],size];
len ← MIN[MAX[0,len],size-start];
end ← start+len;
found ← FALSE;
IF looksOnly THEN {
lks: TextLooks.Looks;
runLen: Offset;
RunReader.SetPosition[runReader,runs,start];
at ← start;
WHILE at < end DO
IF runs=NIL THEN { runLen ← len; lks ← TextLooks.noLooks }
ELSE [runLen,lks] ← RunReader.Get[runReader];
IF ~looksExact THEN lks ← TextLooksSupport.LooksAND[lks,looks];
IF lks = looks THEN EXIT; -- have found a match
at ← at+runLen;
ENDLOOP;
IF at >= end THEN RETURN; -- failed to find a match
RETURN [TRUE,at,at+1,at,at+1] };
psLength ← length;
UNTIL psLength = 0 DO -- discard trailing "any's"
SELECT Pat[patternArray[psLength-1]] FROM
anyStringPat, anyAlphaPat, anyNonAlphaPat, anyBlankPat, anyNonBlankPat => NULL;
ENDCASE => EXIT;
psLength ← psLength-1;
ENDLOOP;
IF psLength=0 THEN RETURN [TRUE,start,start,start,start]; -- null pattern
at ← start;
DO -- text loop
IF firstPatternCharIsNormal THEN {
IF firstPatChar1 = leftBoundaryPattern THEN {
IF at > 0 THEN RETURN; -- failure since not at left boundary
patternPos ← 1; textPos ← 0 }
ELSE { -- search for next instance of first pattern char
at ← MAX[start,at];
RopeReader.SetPosition[ropeReader,rope,at];
UNTIL at >= end DO
SELECT RopeReader.Get[ropeReader] FROM
firstPatChar1, firstPatChar2 =>
IF patternLooks=NIL OR LooksMatch[at,0] THEN EXIT;
ENDCASE;
at ← at+1;
ENDLOOP;
patternPos ← 1; textPos ← at + 1 }}
ELSE { patternPos ← 0; textPos ← at };
IF at >= end THEN EXIT;
stackPtr ← patternAnchor ← 0;
before ← beginPos ← textAnchor ← at;
DO -- pattern loop
IF patternPos >= psLength THEN { -- have finished pattern
found ← TRUE;
textPos ← MIN[end,textPos]; -- in case used final boundary char in making the match
at ← MAX[start,beginPos]; -- in case used initial boundary char in making the match
before ← MAX[before,start]; -- in case used initial boundary char in making the match
atEnd ← IF rightBracketSeen THEN endPos ELSE textPos;
after ← textPos;
GO TO Return };
IF interrupt#NIL AND interrupt^ THEN GO TO Return;
WITH p:patternArray[patternPos] SELECT FROM
startname => { nameArray[p.index].at ← textPos; patternPos ← patternPos+1 };
endname => { nameArray[p.index].atEnd ← textPos; patternPos ← patternPos+1 };
not => { -- check that next character is not the one in this pattern element
char ← GetChar[textPos ! noMoreChars => EXIT];
SELECT patternChar ← p.char FROM
char => IF patternLooks=NIL OR LooksMatch[textPos,patternPos] THEN EXIT;
>= EightBit => { -- check both upper and lower case
IF (SELECT patternChar ← CharBits[patternChar] FROM
IN ['A..'Z] => patternChar = UpperCase[char],
IN ['a ..'z] => patternChar = LowerCase[char],
ENDCASE => patternChar = char)
AND (patternLooks=NIL OR LooksMatch[textPos,patternPos])
THEN EXIT }; -- chars match
ENDCASE;
patternPos ← patternPos+1; textPos ← textPos + 1 };
pattern => { SELECT patternChar ← p.char FROM
leftBracketPattern => { beginPos ← textPos; patternPos ← patternPos+1 };
rightBracketPattern => { endPos ← textPos; patternPos ← patternPos+1 };
nopPattern => patternPos ← patternPos+1;
anyStringPattern => {
IF patternLooks # NIL AND patternLooks[patternPos] # TextLooks.noLooks THEN {
stackPtr ← stackPtr + 1;
textPosStack[stackPtr] ← textPos;
textLenStack[stackPtr] ← -1;
patternPosStack[stackPtr] ← patternPos }
ELSE { textAnchor ← textPos; patternAnchor ← patternPos + 1; stackPtr ← 0 };
patternPos ← patternPos + 1 };
anyNonAlphaPattern, anyAlphaPattern, anyNonBlankPattern, anyBlankPattern => {
stackPtr ← stackPtr + 1;
textPosStack[stackPtr] ← textPos;
textLenStack[stackPtr] ← -1;
patternPosStack[stackPtr] ← patternPos;
patternPos ← patternPos + 1 };
maxStringPattern => {
IF patternLooks # NIL AND patternLooks[patternPos] # TextLooks.noLooks THEN {
stackPtr ← stackPtr + 1;
textPosStack[stackPtr] ← textPos;
textLenStack[stackPtr] ← MaxCount[any];
patternPosStack[stackPtr] ← patternPos }
ELSE {
stackPtr ← 1;
textPosStack[stackPtr] ← textPos;
textLenStack[stackPtr] ← end-textPos;
patternPosStack[stackPtr] ← patternPos };
textPos ← textPos + textLenStack[stackPtr];
patternPos ← patternPos + 1 };
maxNonAlphaPattern, maxAlphaPattern, maxNonBlankPattern, maxBlankPattern => {
stackPtr ← stackPtr + 1;
textPosStack[stackPtr] ← textPos;
textLenStack[stackPtr] ← SELECT patternChar FROM
maxNonAlphaPattern => MaxCount[ne, alphaNumeric],
maxAlphaPattern => MaxCount[eq, alphaNumeric],
maxNonBlankPattern => MaxCount[ne, white],
maxBlankPattern => MaxCount[eq, white],
ENDCASE => ERROR;
textPos ← textPos + textLenStack[stackPtr];
patternPosStack[stackPtr] ← patternPos;
patternPos ← patternPos + 1 };
ENDCASE => { -- check next character from text
boundary: BOOLFALSE;
char ← GetChar[textPos ! noMoreChars => {
char ← rightBoundaryPattern;
IF patternChar # rightBoundaryPattern THEN boundary ← TRUE;
CONTINUE }];
IF ~boundary AND patternChar = oneCharPattern AND
(patternLooks = NIL OR LooksMatch[textPos,patternPos]) THEN {
IF patternPos # 0 AND patternPos = patternAnchor THEN {
-- first char(s) of * segment
patternAnchor ← patternAnchor + 1; textAnchor ← textPos + 1};
patternPos ← patternPos + 1; textPos ← textPos + 1 }
ELSE {
IF ~boundary AND (SELECT patternChar FROM
char => TRUE, -- this also takes care of rightBoundaryPattern
oneNonAlphaPattern => GetCharProp[char] # alphaNumeric,
oneAlphaPattern => GetCharProp[char] = alphaNumeric,
oneNonBlankPattern => GetCharProp[char] # white,
oneBlankPattern => GetCharProp[char] = white,
oneCharPattern => FALSE, -- known from above that looks don't match
>= EightBit => -- check both upper and lower case
SELECT patternChar ← CharBits[patternChar] FROM
IN ['A..'Z] => patternChar = UpperCase[char],
IN ['a ..'z] => patternChar = LowerCase[char],
ENDCASE => patternChar = char,
ENDCASE => FALSE)
AND (patternLooks=NIL OR LooksMatch[textPos,patternPos])
THEN -- chars match -- {
patternPos ← patternPos + 1; textPos ← textPos + 1 }
ELSE { -- chars don't match; try to change some wild card position
WHILE stackPtr # 0 DO
txtpos: Offset ← textPosStack[stackPtr];
txtlen: Offset ← textLenStack[stackPtr];
IF interrupt#NIL AND interrupt^ THEN GO TO Return;
IF txtlen < 0 THEN { -- this is an incrementing wildcard
ppos: NAT;
boundary ← FALSE;
charType ← GetCharProp[GetChar[txtpos !
noMoreChars => { boundary ← TRUE; CONTINUE }]];
IF ~boundary AND
(SELECT Pat[patternArray[ppos←patternPosStack[stackPtr]]] FROM
anyNonAlphaPat => charType # alphaNumeric,
anyAlphaPat => charType = alphaNumeric,
anyNonBlankPat => charType # white,
anyBlankPat => charType = white,
anyStringPat => TRUE,
ENDCASE => ERROR)
AND (patternLooks=NIL OR LooksMatch[txtpos,ppos]) THEN {
patternPos ← ppos + 1;
textPos ← textPosStack[stackPtr] ← txtpos + 1;
EXIT }}
ELSE IF txtlen > 0 THEN { -- this is a decrementing wildcard
patternPos ← patternPosStack[stackPtr] + 1;
textPos ← textPosStack[stackPtr] + txtlen - 1;
textLenStack[stackPtr] ← txtlen - 1;
EXIT }
ELSE NULL; -- decrementing wildcard with no place left to go
stackPtr ← stackPtr - 1;
ENDLOOP;
IF stackPtr = 0 THEN -- failed to match a stacked wild card
IF patternAnchor > 0 AND textAnchor < end THEN {
-- there was a * with no looks, so can advance it
patternPos ← patternAnchor;
textPos ← textAnchor ← textAnchor + 1 }
ELSE EXIT --start matching over at next text location-- }}}};
ENDCASE;
ENDLOOP; -- end of pattern loop
at ← at+1; -- start over with next character
ENDLOOP; -- end of text loop
EXITS Return => NULL;
}; -- of Try --
CharBits: PROC [c: CHAR] RETURNS [CHAR] = INLINE {
RETURN [LOOPHOLE[Inline.BITAND[CharMask,c], CHAR]] };
END.