TextLooksImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
written by Bill Paxton, February 1981
Bill Paxton, December 13, 1982 1:17 pm
Maxwell, January 5, 1983 3:54 pm
Russ Atkinson, July 25, 1983 3:36 pm
Doug Wyatt, March 5, 1985 9:36:11 am PST
Michael Plass, March 29, 1985 5:24:46 pm PST
DIRECTORY
Basics USING [BITAND, HighHalf, LowHalf],
Rope USING [Cat, Fetch, FromChar, ROPE, Size],
RunReader USING [FreeRunReader, Get, GetRunReader, Ref, SetPosition],
TextLooks USING [allLooks, BaseRuns, CountRuns, FlatMax, Look, Looks, MaxOffset, noLooks, Offset, Runs, RunsBody, Tchange, Tconcat, Treplace, Tsubstr],
TextLooksSupport USING [BaseRun, CheckLongSub, CountRunsAfterChanges, ExtractRuns, ExtractRunsAfterChanges, MergeChanges, ModifyLooks, NewBase, Short, TbaseSize];
TextLooksImpl: CEDAR PROGRAM
IMPORTS TextLooks, TextLooksSupport, Rope, RunReader, Basics
EXPORTS TextLooks, TextLooksSupport
= BEGIN OPEN TextLooks;
OutOfBounds: PUBLIC ERROR = CODE;
Rope conversion
LooksToRope: PUBLIC PROC [looks: Looks] RETURNS [rope: Rope.ROPE] = {
FOR lk: TextLooks.Look IN TextLooks.Look DO
IF looks[lk] THEN rope ← Rope.Cat[rope, Rope.FromChar[lk]];
ENDLOOP;
};
RopeToLooks: PUBLIC PROC [rope: Rope.ROPE] RETURNS [looks: Looks] = {
looks ← noLooks;
FOR i: INT IN [0..Rope.Size[rope]) DO
char: CHAR ← Rope.Fetch[rope, i];
IF char IN Look THEN looks[char] ← TRUE;
ENDLOOP;
};
Edit operations
Size: PUBLIC PROC [base: Runs] RETURNS [size: INT] = {
RETURN [IF base = NIL THEN 0 ELSE WITH base SELECT FROM
x: REF RunsBody.base => IF x.length=0 THEN 0 ELSE x[x.length-1].after,
x: REF RunsBody.node.substr => x.size,
x: REF RunsBody.node.concat => x.size,
x: REF RunsBody.node.replace => x.size,
x: REF RunsBody.node.change => x.size,
ENDCASE => ERROR
]
};
Substr: PUBLIC PROC [base: Runs, start: Offset, len: Offset]
RETURNS [new: Runs] = {
DO
IF base=NIL OR len=0 THEN RETURN[NIL];
WITH base SELECT FROM
x: REF RunsBody.base => {
rem: Offset;
IF (rem ← TextLooksSupport.TbaseSize[x]-start) <= len THEN
IF start = 0 THEN RETURN [base] ELSE len ← rem;
};
x: REF RunsBody.node.substr => {
rem: Offset;
IF (rem ← TextLooksSupport.CheckLongSub[x.size, start]) <= len THEN
IF start = 0 THEN RETURN [base] ELSE len ← rem;
start ← start + x.start; base ← x.base; LOOP;
};
x: REF RunsBody.node.concat => {
xpos, rem: Offset;
IF (rem ← TextLooksSupport.CheckLongSub[x.size, start]) <= len THEN
IF start = 0 THEN RETURN [base] ELSE len ← rem;
IF start >= (xpos ← x.pos) THEN {
start ← start - xpos; base ← x.rest; LOOP
};
IF xpos >= start+len THEN {base ← x.base; LOOP};
};
x: REF RunsBody.node.replace => {
xstart, xnew, rem: Offset;
IF (rem ← TextLooksSupport.CheckLongSub[x.size, start]) <= len THEN
IF start = 0 THEN RETURN [base] ELSE len ← rem;
IF start >= (xnew ← x.newPos) THEN {
start ← start - xnew + x.oldPos; base ← x.base; LOOP
};
IF (rem ← start+len) <= (xstart ← x.start) THEN {
base ← x.base; LOOP
};
IF start >= xstart AND rem <= xnew THEN {
start ← start - xstart; base ← x.replace; LOOP
};
};
x: REF RunsBody.node.change => {
xstart: Offset ← x.start;
xend: Offset ← xstart+x.len;
IF start >= xend OR start+len <= xstart THEN {
base ← x.base; LOOP
};
};
ENDCASE => ERROR;
IF (new ← TryFlatSubstr[base, start, len]) # NIL THEN RETURN;
EXIT;
ENDLOOP;
IF base=NIL THEN ERROR;
RETURN [NEW[Tsubstr ← [node[substr[len, base, start]]]]];
};
TryFlatSubstr: PUBLIC PROC
[base: Runs, start, len: Offset, limit: Offset ← FlatMax]
RETURNS [BaseRuns] = { -- return NIL if couldn't flatten
count: Offset;
numruns: NAT;
flat: BaseRuns;
[count, , ] ← CountRuns[base, start, len, limit];
IF count > limit THEN RETURN [NIL];
flat ← TextLooksSupport.NewBase[numruns←TextLooksSupport.Short[count]];
IF TextLooksSupport.ExtractRuns[flat, base, start, len] # numruns THEN ERROR;
IF flat[numruns-1].after # len THEN ERROR;
RETURN [flat];
};
Flatten: PUBLIC PROC [base: Runs] RETURNS [new: Runs] = {
size, half: Offset;
IF base=NIL THEN RETURN [NIL];
WITH base SELECT FROM
x: REF RunsBody.base => RETURN [x]; -- already flat
ENDCASE => NULL;
new ← TryFlatSubstr[base, 0, Size[base], 8000];
IF new#NIL THEN RETURN; -- else was too big to flatten in one piece
half ← (size ← Size[base])/2; -- flatten the halves
RETURN [Concat[
Flatten[Substr[base, 0, half]],
Flatten[Substr[base, half, size]],
half,
size-half]];
};
Concat: PUBLIC PROC
[base, rest: Runs, baseLen, restLen: Offset] RETURNS [new: Runs] = TRUSTED {
c, numRuns, size, flatLen: Offset;
split: NAT;
merge: BOOL;
looks: Looks;
IF base=NIL AND rest=NIL THEN RETURN[NIL];
IF restLen=0 THEN RETURN [base];
IF baseLen=0 THEN RETURN [rest];
size ← baseLen+restLen;
[numRuns, merge, looks] ← CountRuns[base, 0, baseLen, FlatMax];
IF numRuns <= FlatMax THEN { -- try flattening base
IF (new ← TryFlatConcatRest[base, rest, baseLen, restLen,
numRuns, merge, looks]) # NIL THEN RETURN;
otherwise try to break up rest
IF rest # NIL THEN WITH rest SELECT FROM
x: REF RunsBody.node.concat => { -- try to combine base & rest.base
[c, , ] ← CountRuns[x.base, 0, x.pos, FlatMax-numRuns, merge, looks];
IF (numRuns ← numRuns+c) <= FlatMax THEN { -- flatten
numruns: NAT;
flat: BaseRuns ← TextLooksSupport.NewBase[numruns←TextLooksSupport.Short[numRuns]];
split ← TextLooksSupport.ExtractRuns[flat, base, 0, baseLen];
IF TextLooksSupport.ExtractRuns[flat, x.base, 0, x.pos, split] # numruns
THEN ERROR;
flatLen ← baseLen+x.pos;
IF flat[numruns-1].after # flatLen THEN ERROR;
RETURN[NEW[Tconcat ← [node[concat
[size, flat, x.rest, flatLen]]]]]
}
};
ENDCASE => NULL;
};
IF base # NIL THEN WITH base SELECT FROM
x: REF RunsBody.node.concat => { -- try to combine base.rest & rest
baseRestLen: Offset ← baseLen-x.pos;
[numRuns, merge, looks] ← CountRuns[x.rest, 0, baseRestLen, FlatMax];
IF numRuns <= FlatMax THEN {
[c, , ] ← CountRuns[rest, 0, restLen, FlatMax-numRuns, merge, looks];
IF (numRuns ← numRuns+c) <= FlatMax THEN { -- flatten
numruns: NAT;
flat: BaseRuns ← TextLooksSupport.NewBase[numruns←TextLooksSupport.Short[numRuns]];
split ← TextLooksSupport.ExtractRuns[flat, x.rest, 0, baseRestLen];
IF TextLooksSupport.ExtractRuns[flat, rest, 0, restLen, split] # numruns
THEN ERROR;
IF flat[numruns-1].after # baseRestLen+restLen THEN ERROR;
RETURN[NEW[Tconcat ← [node[concat
[size, x.base, flat, x.pos]]]]]
}
}
};
x: REF RunsBody.node.substr => {
see if doing concat of adjacent substr's
WITH rest SELECT FROM
y: REF RunsBody.node.substr => {
see if adjacent to x
IF x.base = y.base AND x.start+x.size = y.start THEN -- join them
RETURN[NEW[Tsubstr ←
[node[substr[size, x.base, x.start]]]]];
};
ENDCASE => NULL;
};
ENDCASE => NULL;
IF base=NIL THEN base ← MakeRun[baseLen];
IF rest=NIL THEN rest ← MakeRun[restLen];
RETURN[NEW[Tconcat ← [node[concat[size, base, rest, baseLen]]]]];
};
TryFlatConcat: PUBLIC PROC
[base, rest: Runs, baseLen, restLen: Offset]
RETURNS [new: BaseRuns] = { -- returns NIL if too big to flatten
numRuns: Offset;
merge: BOOL;
looks: Looks;
[numRuns, merge, looks] ← CountRuns[base, 0, baseLen, FlatMax];
IF numRuns > FlatMax THEN RETURN [NIL];
RETURN [TryFlatConcatRest[base, rest, baseLen, restLen, numRuns, merge, looks]];
};
TryFlatConcatRest: PUBLIC PROC
[base, rest: Runs, baseLen, restLen, numRuns: Offset,
merge: BOOL, looks: Looks]
RETURNS [BaseRuns] = { -- returns NIL if too big to flatten
c: Offset;
split, numruns: NAT;
flat: BaseRuns;
[c, , ] ← CountRuns[rest, 0, restLen, FlatMax-numRuns, merge, looks];
IF (numRuns ← numRuns+c) > FlatMax THEN RETURN [NIL];
flat ← TextLooksSupport.NewBase[numruns←TextLooksSupport.Short[numRuns]];
split ← TextLooksSupport.ExtractRuns[flat, base, 0, baseLen];
IF TextLooksSupport.ExtractRuns[flat, rest, 0, restLen, split] # numruns THEN
ERROR;
IF flat[numruns-1].after # baseLen+restLen THEN ERROR;
RETURN [flat];
};
Replace: PUBLIC PROC [
base: Runs, start, len: Offset, replace: Runs,
baseSize, repSize: Offset, tryFlat: BOOL ← TRUE]
RETURNS [new: Runs] = {
oldPos, newPos, size: Offset;
IF base=NIL AND replace=NIL THEN RETURN [NIL];
oldPos ← start+len;
newPos ← start+repSize;
size ← baseSize-len+repSize;
IF repSize=0 THEN -- deleting
IF base=NIL OR (start=0 AND len=baseSize) THEN RETURN[NIL]
ELSE IF len=0 THEN RETURN[base];
IF tryFlat THEN {
merge: BOOL ← FALSE;
flat: BaseRuns;
looks: Looks;
c, numRuns: Offset;
split, numruns: NAT;
Count: PROC [r: Runs, start, len: Offset] RETURNS [Offset] = TRUSTED {
IF len=0 THEN RETURN[numRuns];
[c, merge, looks] ← CountRuns[r, start, len, FlatMax-numRuns, merge, looks];
RETURN [numRuns←numRuns+c]
};
Extract: PROC [r: Runs, start, len: Offset] = TRUSTED {
IF len > 0 THEN split ← TextLooksSupport.ExtractRuns[flat, r, start, len, split]
};
numRuns ← 0;
IF Count[base, 0, start] <= FlatMax AND
Count[replace, 0, repSize] <= FlatMax AND
Count[base, oldPos, baseSize-oldPos] <= FlatMax THEN {
flat ← TextLooksSupport.NewBase[numruns←TextLooksSupport.Short[numRuns]]; split ← 0;
Extract[base, 0, start]; Extract[replace, 0, repSize];
Extract[base, oldPos, baseSize-oldPos];
IF split # numruns THEN ERROR;
IF flat[numruns-1].after # size THEN ERROR;
RETURN [flat]
}
};
WHILE base # NIL DO WITH base SELECT FROM
x: REF RunsBody.node.replace => {
xnewPos: Offset ← x.newPos;
xstart: Offset ← x.start;
xsize: Offset;
IF start <= xstart AND oldPos >= xnewPos THEN {
replacing the replacement
oldPos ← x.oldPos+(oldPos-xnewPos); len ← oldPos-start;
base ← x.base; LOOP
}
ELSE IF repSize = 0 AND start > xstart AND
oldPos = xnewPos AND -- deleting end of prior replacement
(new ← TryFlatSubstr[x.replace, 0, start-xstart])#NIL THEN {
newPos ← start; oldPos ← x.oldPos; start ← xstart;
replace ← new; base ← x.base
}
ELSE IF repSize = 0 AND start = xstart AND
oldPos < xnewPos AND -- deleting start of prior replacement
(new ← TryFlatSubstr[x.replace, len, xnewPos-oldPos])#NIL THEN {
newPos ← start+xnewPos-oldPos; oldPos ← x.oldPos;
replace ← new; base ← x.base
}
ELSE IF start = xnewPos AND -- replacing just after prior replacement
(new ← TryFlatConcat[x.replace, replace, xsize←xnewPos-xstart, repSize])#NIL
THEN {
start ← xstart;
len ← len+x.oldPos-xstart; oldPos ← start+len;
repSize ← xsize+repSize; newPos ← start+repSize;
replace ← new; base ← x.base; LOOP
}
ELSE IF start+len = xstart AND -- replacing just before prior replacement
(new ← TryFlatConcat[replace, x.replace, repSize, xsize←xnewPos-xstart])#NIL
THEN {
len ← len+x.oldPos-xstart; oldPos ← start+len;
repSize ← xsize+repSize; newPos ← start+repSize;
replace ← new; base ← x.base; LOOP
}
};
x: REF RunsBody.node.concat => {
xpos: Offset ← x.pos;
IF start=xpos AND len=0 THEN { -- insert between base&rest
first try concat of x.base&replacement
IF (new ← TryFlatConcat[x.base, replace, xpos, repSize])#NIL
THEN RETURN [NEW[Tconcat ←
[node[concat[size, new, x.rest, xpos+repSize]]]]];
otherwise try concat of replacement&x.rest
IF (new ← TryFlatConcat[replace, x.rest, repSize, x.size-xpos])#NIL
THEN RETURN [NEW[Tconcat ←
[node[concat[size, x.base, new, x.pos]]]]]
}
};
ENDCASE => NULL;
EXIT;
ENDLOOP;
IF base=NIL THEN base ← MakeRun[baseSize];
IF replace=NIL THEN replace ← MakeRun[repSize];
RETURN [NEW[Treplace ← [node[replace[size, base, replace, start, oldPos, newPos]]]]];
};
Copy: PUBLIC PROC [
dest: Runs, destLoc: Offset, source: Runs,
start, len, destSize: Offset]
RETURNS [Runs] = {
merge: BOOL ← FALSE;
flat: BaseRuns;
looks: Looks;
c, numRuns: Offset;
split, numruns: NAT;
Count: PROC [base: Runs, start, len: Offset] RETURNS [Offset] = {
IF len=0 THEN RETURN[numRuns];
[c, merge, looks] ← CountRuns[base, start, len, FlatMax-numRuns, merge, looks];
RETURN [numRuns←numRuns+c]
};
Extract: PROC [base: Runs, start, len: Offset] = {
IF len > 0 THEN split ← TextLooksSupport.ExtractRuns[flat, base, start, len, split]
};
IF dest=NIL AND source=NIL THEN RETURN[NIL];
numRuns ← 0;
IF Count[dest, 0, destLoc] > FlatMax OR
Count[source, start, len] > FlatMax OR
Count[dest, destLoc, destSize-destLoc] > FlatMax THEN RETURN [
Replace[dest, destLoc, 0, Substr[source, start, len], destSize, len, FALSE]];
IF numRuns=0 THEN RETURN [NIL];
flat ← TextLooksSupport.NewBase[numruns←TextLooksSupport.Short[numRuns]]; split ← 0;
Extract[dest, 0, destLoc]; Extract[source, start, len];
Extract[dest, destLoc, destSize-destLoc];
IF split # numruns THEN ERROR;
IF flat[numruns-1].after # destSize+len THEN ERROR;
RETURN [flat];
};
General operations
CreateRun: PUBLIC PROC [len: Offset, looks: Looks ← noLooks]
RETURNS [new: Runs] = {
base: BaseRuns;
IF looks=noLooks OR len=0 THEN RETURN [NIL];
base ← TextLooksSupport.NewBase[1];
base[0] ← [len, looks];
RETURN [base];
};
MakeRun: PUBLIC PROC [len: Offset] RETURNS [new: Runs] = {
base: BaseRuns;
IF len=0 THEN RETURN [NIL];
base ← TextLooksSupport.NewBase[1];
base[0] ← [len, noLooks];
RETURN [base];
};
FetchLooks: PUBLIC PROC
[runs: Runs, index: Offset] RETURNS [Looks] = {
returns the looks for the character at the given location
remove, add: Looks ← noLooks;
changeLooks: BOOL ← FALSE;
DO IF runs=NIL THEN RETURN [noLooks];
WITH runs SELECT FROM
x: REF RunsBody.base => {
looks: Looks ← x[TextLooksSupport.BaseRun[x, index]].looks;
IF changeLooks THEN looks ← TextLooksSupport.ModifyLooks[looks, remove, add];
RETURN [looks]
};
x: REF RunsBody.node.substr =>
IF index < x.size THEN {
index ← index + x.start; runs ← x.base; LOOP
};
x: REF RunsBody.node.concat => {
IF index < x.size THEN {
IF index < x.pos
THEN {runs ← x.base; LOOP}
ELSE {index ← index - x.pos; runs ← x.rest; LOOP};
};
};
x: REF RunsBody.node.replace => IF index < x.size THEN {
IF index < x.start THEN {runs ← x.base; LOOP};
IF index < x.newPos THEN {
index ← index - x.start; runs ← x.replace; LOOP
};
index ← index - x.newPos + x.oldPos; runs ← x.base; LOOP
};
x: REF RunsBody.node.change => {
IF index IN [x.start..x.start+x.len) THEN {
[remove, add] ← TextLooksSupport.MergeChanges[x.remove, x.add, remove, add];
IF remove=allLooks THEN RETURN [add];
changeLooks ← TRUE
};
runs ← x.base; LOOP
};
ENDCASE => ERROR;
ERROR OutOfBounds;
ENDLOOP;
};
Operation to change looks
ChangeLooks: PUBLIC PROC [
runs: Runs, size: Offset, remove, add: Looks,
start: Offset ← 0, len: Offset ← MaxOffset]
RETURNS [new: Runs] = {
c, numRuns, end: Offset;
merge: BOOL;
looks: Looks;
IF runs=NIL AND add=noLooks THEN RETURN [NIL];
IF start >= size OR len=0 THEN RETURN [runs];
end ← start + (len ← MIN[len, size-start]);
IF runs # NIL THEN { -- see if not really changing anything
changed: BOOL ← FALSE;
loc, runLen: Offset ← start;
addLow, addHigh, remLow, remHigh: CARDINAL;
noLooksLow: CARDINAL = 0;
noLooksHigh: CARDINAL = 0;
runrdr: RunReader.Ref ← RunReader.GetRunReader[];
RunReader.SetPosition[runrdr, runs, start];
addLow ← Basics.LowHalf[LOOPHOLE[add]];
addHigh ← Basics.HighHalf[LOOPHOLE[add]];
remLow ← Basics.LowHalf[LOOPHOLE[remove]];
remHigh ← Basics.HighHalf[LOOPHOLE[remove]];
UNTIL loc >= end DO -- check the runs in the section to be changed
lks: Looks;
lksLow, lksHigh: CARDINAL;
[runLen, lks] ← RunReader.Get[runrdr];
lksLow ← Basics.LowHalf[LOOPHOLE[lks]];
lksHigh ← Basics.HighHalf[LOOPHOLE[lks]];
IF
Basics.BITAND[lksLow, addLow] # addLow OR
Basics.BITAND[lksHigh, addHigh] # addHigh OR
Basics.BITAND[lksLow, remLow] # noLooksLow OR
Basics.BITAND[lksHigh, remHigh] # noLooksHigh
THEN { changed ← TRUE; EXIT };
loc ← loc+runLen;
ENDLOOP;
RunReader.FreeRunReader[runrdr];
IF ~changed THEN RETURN [runs];
};
[numRuns, merge, looks] ← CountRuns[runs, 0, start, FlatMax];
IF numRuns <= FlatMax THEN {
[c, merge, looks] ← TextLooksSupport.CountRunsAfterChanges[
runs, start, len, FlatMax-numRuns, remove, add, merge, looks];
IF (numRuns ← numRuns+c) <= FlatMax THEN {
[c, , ] ← CountRuns[runs, end, size-end, FlatMax-numRuns, merge, looks];
IF (numRuns ← numRuns+c) <= FlatMax THEN {
split, numruns: NAT;
flat: BaseRuns ← TextLooksSupport.NewBase[numruns←TextLooksSupport.Short[numRuns]];
split ← TextLooksSupport.ExtractRuns[flat, runs, 0, start];
split ← TextLooksSupport.ExtractRunsAfterChanges[flat, runs, remove, add, start, len, split];
IF TextLooksSupport.ExtractRuns[flat, runs, end, size-end, split] # numruns THEN ERROR;
IF flat[numruns-1].after # size THEN ERROR;
RETURN [flat]
}
}
};
IF runs # NIL THEN WITH runs SELECT FROM
x: REF RunsBody.node.change => IF x.start=start AND x.len=len THEN {
[remove, add] ← TextLooksSupport.MergeChanges[x.remove, x.add, remove, add];
runs ← x.base
};
ENDCASE => NULL;
IF runs = NIL THEN runs ← MakeRun[size];
RETURN[NEW[Tchange ← [node[change[size, runs, remove, add, start, len]]]]];
};
END.