TiogaSpanEditImpl.mesa
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
written by Bill Paxton, June 1981
last edit by Bill Paxton, December 23, 1982 2:47 pm
Last Edited by: Maxwell, January 5, 1983 12:46 pm
Last Edited by: Paul Rovner, August 10, 1983 4:25 pm
Michael Plass, May 9, 1986 12:03:23 pm PDT
Doug Wyatt, September 22, 1986 5:14:45 pm PDT
DIRECTORY
Tioga USING [CapChange, ChangeTextCaps, ChangeTextLooks, CopyProp, CopyText, DeleteText, LastSibling, LastWithin, Level, Location, Looks, MapProps, maxLen, MoveText, MoveTextOnto, NewNode, Next, Node, NodeBody, nodeItself, nullLocation, nullSpan, Order, Parent, Place, Previous, ReplaceText, Root, Size, Span, StepBackward, StepForward, Text, TransposeText],
TiogaPrivate USING [Change, EditNotify, Is, NoteEvent, PutProp, World, WorldRep];
TiogaSpanEditImpl: CEDAR MONITOR
IMPORTS Tioga, TiogaPrivate
EXPORTS Tioga
= BEGIN OPEN TiogaPrivate, Tioga;
World: TYPE ~ TiogaPrivate.World;
WorldRep: PUBLIC TYPE ~ TiogaPrivate.WorldRep;
Slices
Slice: TYPE = REF SliceArray;
SliceArray: TYPE = RECORD [
next: Slice, -- for free list
length: NAT ← 0,
nodes: SEQUENCE maxLength: NAT OF Node
];
SliceKind: TYPE = { before, after };
SliceLength: PROC [slice: Slice] RETURNS [NAT]
= INLINE { RETURN [slice.length] };
SliceNode: PROC [slice: Slice, index: NAT] RETURNS [Node]
= INLINE { RETURN [slice[index]] };
LastOfSlice: PROC [slice: Slice] RETURNS [Node]
= INLINE { RETURN [slice[slice.length-1]] };
KindOfSlice: PROC [slice: Slice] RETURNS [SliceKind]
= INLINE { RETURN [IF slice[0]#NIL THEN before ELSE after] };
MONITOR: Slice allocation
freeSlice: Slice; -- free list of slices
numFreeSlices: NAT ← 0;
maxFreeSlices: NAT = 15;
minSliceSize: NAT = 10;
GetSlice: ENTRY PROC [len: NAT] RETURNS [Slice] = {
prev: Slice ← NIL;
FOR slice: Slice ← freeSlice, (prev ← slice).next UNTIL slice=NIL DO
IF slice.maxLength>=len THEN { -- take this one
IF prev=NIL THEN freeSlice ← slice.next ELSE prev.next ← slice.next;
slice.next ← NIL; slice.length ← len;
numFreeSlices ← numFreeSlices-1;
RETURN [slice];
};
ENDLOOP;
RETURN [NEW[SliceArray[MAX[len, minSliceSize]]]];
};
FreeSlice: ENTRY PROC [slice: Slice] = {
IF slice=NIL OR slice.maxLength<minSliceSize OR numFreeSlices>=maxFreeSlices THEN NULL
ELSE {
FOR i: NAT IN [0..slice.length) DO slice[i] ← NIL ENDLOOP;
slice.next ← freeSlice; freeSlice ← slice;
numFreeSlices ← numFreeSlices+1;
};
};
Slice support routines
Invariant: PROC [predicate: BOOL] ~ INLINE { true: BOOL[TRUE..TRUE] ~ predicate; };
MakeSlices: PROC [node: Node] RETURNS [before, after: Slice ← NIL] = {
before[0]=root; before[i]=Parent[before[i+1]]; before[before.length-1]=node
after[i]=Next[before[i]]
if node.child # NIL then after[before.length]=node.child
IF node#NIL THEN {
Slicer: PROC [node: Node, height: NAT] RETURNS [before, after: Slice, level: NAT] ~ {
IF node=NIL THEN { -- have gone beyond root
RETURN[GetSlice[height], GetSlice[height+1], 0];
}
ELSE {
[before, after, level] ← Slicer[Parent[node], height+1];
before[level] ← node; after[level] ← Next[node];
RETURN[before, after, level+1];
};
};
[before, after, ] ← Slicer[node, 0];
Invariant[before.length=after.length+1];
after[before.length] ← node.child;
FOR i: NAT DECREASING IN [0..after.length) DO -- delete trailing NILs from after
IF after[i]=NIL THEN after.length ← i ELSE EXIT;
ENDLOOP
};
};
MakeParentSlice: PROC [node: Node] RETURNS [slice: Slice ← NIL] = {
result is same as MakeSlices[node].before
Slicer: PROC [node: Node, height: NAT] RETURNS [slice: Slice, level: NAT] ~ {
IF node=NIL THEN { -- have gone beyond root
RETURN[GetSlice[height], 0];
}
ELSE {
[slice, level] ← Slicer[Parent[node], height+1];
slice[level] ← node;
RETURN[slice, level+1];
};
};
IF node#NIL THEN [slice, ] ← Slicer[node, 0];
};
InsertPrefix: PROC [first, last: Slice, firstLen: NAT] RETURNS [new: Slice] = {
new[i]=first[i] for i in [0..firstLen)
new[i+firstLen]=last[i] for i in [0..last.length)
new.length=firstLen+last.length
Invariant[KindOfSlice[first]=before AND KindOfSlice[last]=before];
Invariant[firstLen>first.length];
new ← GetSlice[firstLen+last.length];
FOR i: NAT IN [0..firstLen) DO new[i] ← first[i]; ENDLOOP;
FOR i: NAT IN [0..last.length) DO new[firstLen+i] ← last[i]; ENDLOOP
};
DeletePrefix: PROC [slice: Slice, depth: NAT] = {
remove entries from start of slice
newLen: NAT ~ slice.length-depth;
FOR i: NAT IN [0..newLen) DO slice[i] ← slice[depth+i]; ENDLOOP;
FOR i: NAT IN [newLen..slice.length) DO slice[i] ← NIL; ENDLOOP;
slice.length ← newLen;
};
NeededNestingChange: TYPE = { needNest, needUnNest, ok };
NeedNestingChange: PROC [before, after, top, bottom: Slice, nesting: INTEGER, depth: NAT] RETURNS [NeededNestingChange] = {
bandStart, afterOver: INTEGER;
topLen, botLen: NAT;
nesting ← MIN[1,nesting];
topLen ← top.length; botLen ← bottom.length;
bandStart ← before.length+nesting-(topLen-depth);
IF bandStart <= 0 THEN RETURN [needNest]; -- must be at least 1
afterOver ← after.length-(botLen-depth+bandStart);
IF afterOver > 1 THEN RETURN [needUnNest];
RETURN [ok]
};
Splice: PROC [before, after: Slice, beforeStart, afterStart: NAT ← 0] = {
join slices
make after[afterStart+i] be successor of before[beforeStart+i]
if more after's than before's, adopt as children of last before
beforeLen: NAT ~ before.length-beforeStart;
afterLen: NAT ~ after.length-afterStart;
Invariant[KindOfSlice[before]=before AND KindOfSlice[after]=after];
Invariant[afterLen<=beforeLen+1];
FOR i: NAT DECREASING IN [0..beforeLen] DO
bi: NAT ~ i+beforeStart;
ai: NAT ~ i+afterStart;
b: Node ~ IF bi<before.length THEN before[bi] ELSE NIL;
p: Node ~ IF bi>0 THEN before[bi-1] ELSE NIL; -- b's parent
a: Node ~ IF ai<after.length THEN after[ai] ELSE NIL; -- b's successor
IF b=NIL THEN { -- adopt children
IF p=NIL THEN {
IF a#NIL THEN ERROR; -- orphans!
}
ELSE {
p.child ← a;
IF a#NIL THEN LastSibling[a].next ← p;
};
}
ELSE { -- link successor
IF a=NIL THEN { -- no successor
b.next ← p; b.last ← TRUE;
}
ELSE { -- has successor
IF a=b THEN RETURN;
b.next ← a; b.last ← FALSE;
LastSibling[a].next ← p;
};
};
ENDLOOP;
};
ReplaceBand: PROC [before, after, top, bottom: Slice, nesting: INTEGER] = {
do Splices to insert (top..bottom) between (before..after)
nesting tells how to offset last of before vs. last of top
before[before.length-1+nesting] will be predecessor of top[top.length-1]
depth: NAT ~ MAX[1, before.length+MIN[nesting, 1]-top.length];
fullBottom: Slice ~ InsertPrefix[before, bottom, depth];
Splice[fullBottom, after];
Splice[before, top, depth];
FreeSlice[fullBottom]
};
BadBand: ERROR = CODE;
DescribeBand: PROC [first, last: Node] RETURNS [before, after, top, bottom: Slice ← NIL, nesting: INTEGER, depth: NAT] = {
ENABLE UNWIND => { FreeSlice[before]; FreeSlice[after]; FreeSlice[top]; FreeSlice[bottom] };
top[top.length-1] = first
before[before.length-1+nesting] = predecessor of first
bottom[bottom.length-1] = last
raises BadBand error if last doesn't follow first in tree structure
or if first or last is root node
pred: Node ← StepBackward[first];
minDepth: NAT;
IF pred=NIL THEN ERROR BadBand; -- first is root node
IF pred=last THEN ERROR BadBand; -- this actually happened during testing!
[before, top] ← MakeSlices[pred];
nesting ← top.length-before.length; -- nesting of LastOfSlice[top] wrt LastOfSlice[before]
[bottom, after] ← MakeSlices[last];
minDepth ← MIN[before.length, bottom.length];
FOR depth ← 0, depth+1 UNTIL depth >= minDepth DO
IF before[depth] # bottom[depth] THEN { -- check for legality
bot: Node ← bottom[depth];
FOR node: Node ← before[depth], Next[node] DO
IF node=bot THEN EXIT;
IF node=NIL THEN ERROR BadBand; -- last must come before first
ENDLOOP;
EXIT;
};
ENDLOOP;
IF depth=0 THEN ERROR BadBand; -- different root nodes for first and last
check assertions
Invariant[LastOfSlice[top]=first AND LastOfSlice[bottom]=last];
Invariant[before[before.length+nesting-2]=Parent[first]];
};
DestSlices: PROC [dest: Node, where: Place] RETURNS [before, after: Slice, nesting: INTEGER] = {
where = after means insert starting as sibling after dest
where = child means insert starting as child of dest
where = before means insert starting as sibling before dest
SELECT where FROM
after => { [before, after] ← MakeSlices[dest]; nesting ← 0 };
child => { [before, after] ← MakeSlices[dest]; nesting ← 1 };
before => {
pred: Node ← StepBackward[dest];
[before, after] ← MakeSlices[pred];
nesting ← after.length-before.length;
};
ENDCASE => ERROR;
};
CreateDest: PROC [depth: NAT] RETURNS [dest: Location] = {
create tree of parents
node: Node ← NIL;
THROUGH [0..depth) DO
child: Node ~ NewNode[];
IF node#NIL THEN { node.child ← child; child.next ← node; child.last ← TRUE; };
node ← child;
ENDLOOP;
RETURN [[node, nodeItself]];
};
CopySpan: PROC [span: Span] RETURNS [result: Span] = {
node, prev, parent, first: Node ← NIL;
IF (node ← span.start.node)=NIL THEN RETURN [nullSpan];
parent ← NewNode[]; -- parent for the span
DO -- create new node each time through the loop
new: Node ~ NEW[NodeBody];
new.new ← TRUE;
new.rope ← node.rope;
new.runs ← node.runs;
Inherit[old: node, new: new, allprops: TRUE]; -- inherit properties from node
IF prev=NIL THEN parent.child ← new
ELSE { prev.last ← FALSE; prev.next ← new }; -- insert new
new.last ← TRUE; new.next ← parent;
IF node=span.start.node THEN first ← new;
IF node=span.end.node THEN RETURN [[[first, span.start.where], [new, span.end.where]]];
go to next node
prev ← new;
IF node.child#NIL THEN { -- descend in the tree
node ← node.child; parent ← new; prev ← NIL;
}
ELSE DO -- move to next node, sibling or up* then sibling
IF node.last THEN { -- move up to node's parent
node ← node.next; -- node ← node.parent
IF node=NIL THEN RETURN [nullSpan]; -- bad arg span
Invariant[parent.last];
prev ← parent; -- next new node will be parent's sibling
parent ← parent.next; -- parent ← parent.parent
IF parent=NIL THEN { -- need a new parent
parent ← NewNode[];
parent.child ← prev;
prev.next ← parent;
};
}
ELSE { node ← node.next; EXIT }; -- move to next sibling
ENDLOOP;
ENDLOOP;
};
CompareSliceOrder: PROC [s1, s2: Slice] RETURNS [order: Order] = {
determines relative order in tree of last nodes in the slices
returns "same" if slices are identical
returns "before" if last node of s1 comes before last node of s2
returns "after" if last node of s1 comes after last node of s2
returns "disjoint" if slices are not from the same tree
IF s1=NIL OR s2=NIL OR s1.length=0 OR s2.length=0 THEN RETURN [disjoint];
Invariant[KindOfSlice[s1]=before AND KindOfSlice[s2]=before]; -- only valid for parent slices
IF s1[0]#s2[0] THEN RETURN [disjoint]; -- different roots
FOR i: NAT IN[1..MIN[s1.length, s2.length]) DO
n1: Node ~ s1[i];
n2: Node ~ s2[i];
IF n1#n2 THEN { -- they are siblings, so can check order by Next's
FOR n: Node ← Next[n1], Next[n] DO -- search from s1 to s2
IF n=n2 THEN RETURN [before]; -- n1 comes before n2
IF n=NIL THEN RETURN [after]; -- n2 not found, so n1 must be after n2
ENDLOOP;
};
ENDLOOP;
SELECT s1.length FROM
<s2.length => RETURN [before]; -- s1Last is a parent of s2Last
=s2.length => RETURN [same]; -- s1Last=s2Last
>s2.length => RETURN [after]; -- s2Last is a parent of s1Last
ENDCASE => ERROR;
};
CompareNodeOrder: PUBLIC PROC [node1, node2: Node] RETURNS [Order] = {
IF node1=NIL OR node2=NIL THEN RETURN [disjoint];
IF node1=node2 THEN RETURN [same]
ELSE {
s1: Slice ~ MakeParentSlice[node1];
s2: Slice ~ MakeParentSlice[node2];
order: Order ~ CompareSliceOrder[s1, s2];
FreeSlice[s1];
FreeSlice[s2];
RETURN[order];
};
};
DoSplits: PROC [world: World, alpha, beta: Span] RETURNS [Span, Span] = {
split off head or tail sections of text
MakeSplit: PROC [split: Location] ~ {
IF split.node#NIL AND split.where#nodeItself THEN {
new: Node ~ Split[world, Root[split.node], split];
FixLoc: PROC [old: Location] RETURNS [Location] ~ {
IF old.node=split.node THEN {
Invariant[old.where#nodeItself];
IF old.where>=split.where THEN RETURN [[new, old.where-split.where]];
};
RETURN[old];
};
alpha.start ← FixLoc[alpha.start];
alpha.end ← FixLoc[alpha.end];
beta.start ← FixLoc[beta.start];
beta.end ← FixLoc[beta.end]
};
};
IF alpha.start.where#nodeItself THEN MakeSplit[alpha.start];
IF beta.start.where#nodeItself THEN MakeSplit[beta.start];
IF alpha.end.where#nodeItself THEN MakeSplit[alpha.end];
IF beta.end.where#nodeItself THEN MakeSplit[beta.end];
RETURN [alpha, beta]
};
DoSplits2: PROC [world: World, dest: Location, source: Span, where: Place, nesting: INTEGER] RETURNS [Location, Span, Place, INTEGER] = {
destLoc: Location;
destSpan: Span ← [dest, nullLocation];
[destSpan, source] ← DoSplits[world, destSpan, source];
destLoc ← destSpan.start;
IF dest.where # nodeItself THEN { -- did a split
destLoc ← BackLoc[destLoc]; where ← after; nesting ← 0;
};
RETURN [destLoc, source, where, nesting]
};
ReMerge: PROC [world: World, alpha, beta: Span, merge: Node, tail: BOOLFALSE] RETURNS [Span, Span] = {
IF tail THEN merge ← StepForward[merge];
IF merge#NIL THEN {
loc: Location ~ Merge[world, Root[merge], merge];
FixLoc: PROC [old: Location] RETURNS [Location] = {
IF old.node=merge THEN {
Invariant[old.where#nodeItself];
RETURN [[loc.node, loc.where+old.where]];
};
RETURN[old];
};
alpha.start ← FixLoc[alpha.start];
alpha.end ← FixLoc[alpha.end];
beta.start ← FixLoc[beta.start];
beta.end ← FixLoc[beta.end];
};
RETURN [alpha, beta]
};
UndoSplits: PROC [world: World, alpha, beta: Span] RETURNS [Span, Span] = {
IF alpha.start.where#nodeItself THEN
[alpha, beta] ← ReMerge[world, alpha, beta, alpha.start.node];
IF beta.start.where#nodeItself THEN
[alpha, beta] ← ReMerge[world, alpha, beta, beta.start.node];
IF alpha.end.where#nodeItself THEN
[alpha, beta] ← ReMerge[world, alpha, beta, alpha.end.node, TRUE];
IF beta.end.where#nodeItself THEN
[alpha, beta] ← ReMerge[world, alpha, beta, beta.end.node, TRUE];
RETURN [alpha, beta];
};
UndoSplits2: PROC [world: World, dest: Location, source: Span] RETURNS [Location, Span] = {
destSpan: Span ← [dest, nullLocation];
[destSpan, source] ← UndoSplits[world, destSpan, source];
RETURN [destSpan.end, source];
};
SliceOrder: PROC [alpha, beta: Span, aBefore, aBottom, bBefore, bBottom: Slice] RETURNS [overlap: BOOL, head, tail: Span, startOrder, endOrder: Order] = {
IF CompareSliceOrder[aBottom, bBefore]#after -- alphaend before betastart
OR CompareSliceOrder[aBefore, bBottom]#before -- alphastart after betaend
THEN { overlap ← FALSE; RETURN };
startOrder ← CompareSliceOrder[aBefore, bBefore];
endOrder ← CompareSliceOrder[aBottom, bBottom];
head ← SELECT startOrder FROM
before => [alpha.start, BackLoc[beta.start]],
same => nullSpan,
after => [beta.start, BackLoc[alpha.start]],
ENDCASE => ERROR;
tail ← SELECT endOrder FROM
before => [ForwardLoc[alpha.end], beta.end],
same => nullSpan,
after => [ForwardLoc[beta.end], alpha.end],
ENDCASE => ERROR;
overlap ← TRUE;
};
Miscellaneous
ApplyToSpanProc: TYPE ~ PROC [node: Node, start, len: INT] RETURNS [stop: BOOL];
ApplyToSpan: PROC [span: Span, proc: ApplyToSpanProc] = {
node, last: Node;
start, lastLen: INT;
IF (node ← span.start.node) = NIL THEN RETURN;
IF (last ← span.end.node) = NIL THEN RETURN;
IF (start ← span.start.where)=nodeItself THEN start ← 0;
IF span.end.where=nodeItself THEN lastLen ← maxLen
ELSE IF span.end.where=maxLen THEN lastLen ← maxLen
ELSE { lastLen ← span.end.where+1; IF node=last THEN lastLen ← lastLen-start };
DO
IF proc[node, start, IF node=last THEN lastLen ELSE maxLen] THEN RETURN;
IF node=last OR (node ← StepForward[node])=NIL THEN RETURN;
start ← 0;
ENDLOOP;
};
BackLoc: PROC [loc: Location] RETURNS [new: Location] = {
new.node ← StepBackward[loc.node];
new.where ← IF loc.where=nodeItself THEN nodeItself ELSE Size[new.node];
};
ForwardLoc: PROC [loc: Location] RETURNS [new: Location] = {
new.node ← StepForward[loc.node];
new.where ← IF loc.where=nodeItself THEN nodeItself ELSE 0;
};
INLINEs
TextFromSpan: PROC [span: Span] RETURNS [Text] ~ INLINE {
RETURN[[span.start.node, span.start.where, span.end.where-span.start.where]];
};
SpanFromText: PROC [text: Text] RETURNS [Span] ~ INLINE {
RETURN[[[text.node, text.start], [text.node, text.start+text.len]]];
};
TextLoc: PROC [loc: Location] RETURNS [BOOL] ~ INLINE {
RETURN [loc.where#nodeItself];
};
TextSpan: PROC [span: Span] RETURNS [BOOL] ~ INLINE {
RETURN [span.start.node=span.end.node AND TextLoc[span.start] AND TextLoc[span.end]];
};
CheckForNil: PROC [span: Span] RETURNS [BOOL] = INLINE {
RETURN [span.start.node = NIL OR span.end.node = NIL]
};
NodeLoc: PROC [node: Node] RETURNS [Location] ~ INLINE {
RETURN[[node, nodeItself]];
};
NodeSpan: PROC [node1, node2: Node] RETURNS [Span] ~ INLINE {
RETURN[[NodeLoc[node1], NodeLoc[node2]]];
};
WholeNodeLoc: PROC [loc: Location] RETURNS [Location] ~ INLINE {
RETURN[NodeLoc[loc.node]];
};
WholeNodeSpan: PROC [span: Span] RETURNS [Span] ~ INLINE {
RETURN[[WholeNodeLoc[span.start], WholeNodeLoc[span.end]]];
};
Nest: PROC [world: World, root: Node, span: Span] RETURNS [Span] ~ INLINE {
RETURN ChangeNesting[world, root, span, +1];
};
UnNest: PROC [world: World, root: Node, span: Span] RETURNS [Span] ~ INLINE {
RETURN ChangeNesting[world, root, span, -1];
};
Paste Span
SaveForPaste: PUBLIC PROC [world: World, span: Span] = {
IF CheckForNil[span] THEN RETURN;
IF TextSpan[span] THEN SaveTextForPaste[world, TextFromSpan[span]]
ELSE SaveSpanForPaste[world, CopySpan[span]]
};
SaveTextForPaste: PROC [world: World, text: Text] = {
span: Span ~ IF text.len=0 THEN nullSpan ELSE SpanFromText[text];
SaveSpanForPaste[world, CopySpan[span]];
};
SaveSpanForPaste: PROC [world: World, span: Span] = {
SaveOldPaste[world];
world.paste ← NEW[Change.ChangingSpanForPaste ← [ChangingSpanForPaste[span]]];
};
SaveOldPaste: PROC [world: World] = {
NoteEvent[world, RestorePaste, world.paste];
world.paste ← NIL
};
RestorePaste: PROC [world: World, undoRef: REF Change] = {
SaveOldPaste[world];
world.paste ← NARROW[undoRef]
};
SavedForPaste: PUBLIC PROC [world: World] RETURNS [span: Span] = {
savedPaste: REF Change ← world.paste;
IF savedPaste=NIL THEN RETURN [nullSpan];
WITH savedPaste SELECT FROM
x: REF Change.ChangingSpanForPaste => RETURN [x.span];
ENDCASE => ERROR;
};
Editing operations on spans
CannotDoEdit: PUBLIC ERROR ~ CODE;
Replace: PUBLIC PROC [world: World, destRoot, sourceRoot: Node, dest, source: Span, saveForPaste: BOOLTRUE] RETURNS [Span] = {
replace dest span by copy of source span
result is the new copy of source
IF TextSpan[dest] AND TextSpan[source] THEN { -- pure text replace
destText: Text ~ TextFromSpan[dest];
sourceText: Text ~ TextFromSpan[source];
IF saveForPaste THEN SaveTextForPaste[world, destText];
RETURN [SpanFromText[ReplaceText[world, destRoot, sourceRoot, destText, sourceText]]];
}
ELSE {
result, newDest: Span;
source ← CopySpan[source];
sourceRoot ← Root[source.start.node];
sourceRoot.deleted ← TRUE;
[result, newDest] ← Transpose[world, sourceRoot, destRoot, source, dest];
IF saveForPaste THEN SaveSpanForPaste[world, newDest];
RETURN[result];
};
};
Delete: PUBLIC PROC [world: World, root: Node, del: Span, saveForPaste: BOOLTRUE] = {
IF CheckForNil[del] THEN RETURN;
IF TextSpan[del] THEN { -- pure text
delText: Text ~ TextFromSpan[del];
IF saveForPaste THEN SaveTextForPaste[world, delText];
DeleteText[world, root, delText];
}
ELSE {
d: Span ~ MoveToLimbo[world, root, del];
IF saveForPaste THEN SaveSpanForPaste[world, d]
};
};
MoveToLimbo: PROC [world: World, root: Node, span: Span] RETURNS [result: Span] = {
RETURN [Move[world, NIL, root, nullLocation, span, after, 1]]
};
Copy: PUBLIC PROC [world: World, destRoot, sourceRoot: Node, dest: Location, source: Span, where: Place ← after, nesting: INT ← 0] RETURNS [result: Span] = {
result is the new copy of source
IF CheckForNil[source] OR dest.node=NIL THEN RETURN [nullSpan];
IF TextLoc[dest] AND TextSpan[source] THEN { -- pure text copy
sourceText: Text ~ TextFromSpan[source];
RETURN[SpanFromText[CopyText[world, destRoot, sourceRoot, dest, sourceText]]];
}
ELSE {
source ← CopySpan[source];
sourceRoot ← Root[source.start.node];
sourceRoot.deleted ← TRUE;
result ← Move[world, destRoot, sourceRoot, dest, source, where, nesting];
};
};
Move: PUBLIC PROC [world: World, destRoot, sourceRoot: Node, dest: Location, source: Span, where: Place ← after, nesting: INT ← 0] RETURNS [result: Span] = {
dest cannot be within source
result is moved span
sBefore, sAfter, sTop, sBottom, dBefore, dAfter: Slice;
sNesting, dNesting: INT;
sDepth: NAT;
beforeSource, afterSource: Node; -- nodes adjacent to source after do splits
afterLoc: Location;
FreeSlices: PROC = {
FreeSlice[sBefore]; FreeSlice[sAfter]; FreeSlice[sTop]; FreeSlice[sBottom];
FreeSlice[dBefore]; FreeSlice[dAfter];
sBefore ← sAfter ← sTop ← sBottom ← dBefore ← dAfter ← NIL
};
ForcedUnNest: PROC [afterNode: Node] = {
span: Span = NodeSpan[afterNode, LastWithin[afterNode]];
FreeSlices[];
[] ← UnNest[world, Root[afterNode], span]
};
ForcedNest: PROC = {
span: Span ← NodeSpan[sTop[sDepth], LastWithin[sBottom[sDepth]]];
IF SliceLength[sTop] = sDepth+1 THEN { -- can't do it by calling Nest
IF nesting >= 1 THEN ERROR;
nesting ← nesting+1; -- move to a deeper position
FreeSlices[];
RETURN
};
FreeSlices[];
[] ← Nest[world, Root[span.start.node], span]
};
IF CheckForNil[source] THEN RETURN [nullSpan];
IF TextLoc[dest] AND TextSpan[source] THEN { -- pure text move
sourceText: Text ~ TextFromSpan[source];
RETURN[SpanFromText[MoveText[world, destRoot, sourceRoot, dest, sourceText]]];
};
IF where=child THEN { where ← after; nesting ← nesting+1 }
ELSE IF where=sibling THEN {
newDest: Node = LastWithin[dest.node];
where ← after;
nesting ← nesting + Level[dest.node] - Level[newDest];
dest ← [newDest, nodeItself];
};
split source and dest, if necessary, so can deal with entire nodes
[dest, source, where, nesting] ← DoSplits2[world, dest, source, where, nesting];
beforeSource ← StepBackward[source.start.node];
afterSource ← StepForward[source.end.node];
afterLoc ← [afterSource, 0];
{ -- for exits
check for dest already in correct position
IF dest # nullLocation AND
((where = after AND (dest.node = beforeSource OR dest.node = source.end.node))
OR (where = before AND (dest.node = afterSource OR dest.node = source.start.node)))
THEN { -- not going anywhere, but might be changing nesting
IF nesting > 0 THEN
FOR i:INT IN [0..nesting) DO
[] ← Nest[world, sourceRoot, WholeNodeSpan[source]];
ENDLOOP
ELSE IF nesting < 0 THEN
FOR i:INT IN [nesting..0) DO
[] ← UnNest[world, sourceRoot, WholeNodeSpan[source]];
ENDLOOP
}
ELSEDO -- repeat this loop only if have forced nest or unnest or source and dest in same tree
check for dest inside source
[sBefore, sAfter, sTop, sBottom, sNesting, sDepth] ←
DescribeBand[source.start.node, source.end.node ! BadBand =>
{ source ← nullSpan; GOTO ErrorReturn } ];
IF dest = nullLocation THEN { -- moving to limbo
dest ← CreateDest[SliceLength[sTop]-sDepth];
destRoot ← Root[dest.node];
destRoot.deleted ← TRUE; -- so will free this when it falls off the edit history list
where ← after; nesting ← 1
};
[dBefore, dAfter, dNesting] ← DestSlices[dest.node, where];
IF CompareSliceOrder[dBefore, sBefore]=after AND
CompareSliceOrder[dBefore, sBottom]=before THEN GOTO ErrorReturn;
dest inside source
IF dBefore[0] = sBefore[0] THEN { -- source and dest in same tree
span: Span = NodeSpan[source.start.node, source.end.node];
FreeSlices[];
[] ← MoveToLimbo[world, sourceRoot, span];
LOOP
};
dNesting ← dNesting + nesting;
SELECT NeedNestingChange[dBefore, dAfter, sTop, sBottom, dNesting, sDepth] FROM
needUnNest => { ForcedUnNest[LastOfSlice[dAfter]]; LOOP };
needNest => { ForcedNest[]; LOOP };
ENDCASE;
IF SliceLength[sAfter] > SliceLength[sBefore]+1 THEN {
ForcedUnNest[LastOfSlice[sAfter]]; LOOP
}
ELSE { -- do it
notify: REF MovingNodes Change;
notify ← NEW[MovingNodes Change ← [MovingNodes[
destRoot, sourceRoot, dest.node, source.start.node, source.end.node,
LastOfSlice[sBefore], sNesting, (where # before)]]];
EditNotify[world, notify, before];
DeletePrefix[sTop, sDepth]; DeletePrefix[sBottom, sDepth];
ReplaceBand[dBefore, dAfter, sTop, sBottom, dNesting];
Splice[sBefore, sAfter];
FreeSlices[];
EditNotify[world, notify, after];
NoteEvent[world, UndoMoveNodes, notify];
};
EXIT;
ENDLOOP;
IF TextLoc[dest] THEN { -- undo prior splits
start, end: BOOLFALSE;
IF TextLoc[source.start] THEN { -- merge start of source with front of dest
start ← TRUE;
[source, ] ← ReMerge[world, source, nullSpan, source.start.node]
};
IF TextLoc[source.end] THEN { -- merge end of source with tail of dest
end ← TRUE;
[source, ] ← ReMerge[world, source, nullSpan, source.end.node, TRUE]
};
IF start AND end THEN { -- merge before source with after source
afterLoc ← Merge[world, Root[afterSource], afterSource]
}
}
ELSE IF TextLoc[source.start] AND TextLoc[source.end] THEN {
afterLoc ← Merge[world, Root[afterSource], afterSource]
};
world.afterMoved2 ← world.afterMoved1; -- save previous hint
world.afterMoved1 ← IF afterSource=NIL THEN [beforeSource, 0] ELSE afterLoc; -- hint for repaint
RETURN [source];
EXITS ErrorReturn => {
FreeSlices[];
[, source] ← UndoSplits2[world, dest, source];
ERROR CannotDoEdit
}
}
};
UndoMoveNodes: PROC [world: World, undoRef: REF Change] = {
WITH undoRef SELECT FROM
x: REF Change.MovingNodes => [] ← Move[world, x.sourceRoot, x.destRoot, NodeLoc[x.pred], NodeSpan[x.first, x.last], after, x.nesting];
ENDCASE => ERROR
};
Transpose: PUBLIC PROC [world: World, alphaRoot, betaRoot: Node, alpha, beta: Span] RETURNS [newAlpha, newBeta: Span] = {
newAlpha is new location of alpha span; ditto for newBeta
aBefore, aAfter, aTop, aBottom, bBefore, bAfter, bTop, bBottom: Slice;
aNesting, bNesting: INT;
aDepth, bDepth: NAT;
beforeAlpha, afterAlpha, beforeBeta, afterBeta: Node; -- nodes adjacent after do splits
afterAlphaLoc, afterBetaLoc: Location;
FreeSlices: PROC = {
FreeSlice[aBefore]; FreeSlice[aAfter]; FreeSlice[aTop]; FreeSlice[aBottom];
FreeSlice[bBefore]; FreeSlice[bAfter]; FreeSlice[bTop]; FreeSlice[bBottom];
aBefore ← aAfter ← aTop ← aBottom ← bBefore ← bAfter ← bTop ← bBottom ← NIL
};
{ -- for exit
IF CheckForNil[alpha] OR CheckForNil[beta] THEN RETURN [nullSpan, nullSpan];
IF TextSpan[alpha] AND TextSpan[beta] THEN { -- pure text transpose
alphaText: Text ~ TextFromSpan[alpha];
betaText: Text ~ TextFromSpan[beta];
alphaResultText, betaResultText: Text;
[alphaResultText, betaResultText] ← TransposeText[world, alphaRoot, betaRoot, alphaText, betaText];
newAlpha ← SpanFromText[alphaResultText];
newBeta ← SpanFromText[betaResultText];
RETURN;
};
[alpha, beta] ← DoSplits[world, alpha, beta]; -- so can deal with entire nodes
beforeAlpha ← StepBackward[alpha.start.node];
afterAlpha ← StepForward[alpha.end.node];
afterAlphaLoc ← [afterAlpha, 0];
beforeBeta ← StepBackward[beta.start.node];
afterBeta ← StepForward[beta.end.node];
afterBetaLoc ← [afterBeta, 0];
now check for alpha beta adjacent or overlapping as special cases
IF afterAlpha = beta.start.node THEN { -- alpha just before beta
move beta nodes to before alpha nodes
[] ← Move[world, alphaRoot, betaRoot, WholeNodeLoc[alpha.start], WholeNodeSpan[beta], before, 0]
}
ELSE IF afterBeta = alpha.start.node THEN { -- beta just before alpha
move alpha nodes to before beta nodes
[] ← Move[world, betaRoot, alphaRoot, WholeNodeLoc[beta.start], WholeNodeSpan[alpha], before, 0]
}
ELSE  { -- get slices describing the bands of nodes to be transposed
overlap: BOOL;
head, tail: Span; -- sections of alpha or beta before and after the overlap
startOrder, endOrder: Order;
[aBefore, aAfter, aTop, aBottom, aNesting, aDepth] ←
DescribeBand[alpha.start.node, alpha.end.node ! BadBand =>
{ alpha ← beta ← nullSpan; GOTO ErrorReturn }];
[bBefore, bAfter, bTop, bBottom, bNesting, bDepth] ←
DescribeBand[beta.start.node, beta.end.node ! BadBand =>
{ alpha ← beta ← nullSpan; GOTO ErrorReturn }];
check for overlap
[overlap, head, tail, startOrder, endOrder] ←
SliceOrder[alpha, beta, aBefore, aBottom, bBefore, bBottom];
IF overlap THEN { -- bands overlap
FreeSlices[];
IF head = nullSpan AND tail = nullSpan THEN NULL
ELSE IF head = nullSpan THEN { --move tail to before alphastart
[] ← Move[world, alphaRoot, betaRoot, WholeNodeLoc[alpha.start], WholeNodeSpan[tail], before, 0];
IF endOrder=before THEN { -- alpha end before beta end
beta.start ← tail.start; beta.end ← alpha.end
}
ELSE { -- beta end before alpha end
alpha.start ← tail.start; alpha.end ← beta.end
}
}
ELSE IF tail = nullSpan THEN { --move head to after alphaend
[] ← Move[world, alphaRoot, betaRoot, WholeNodeLoc[alpha.end], WholeNodeSpan[head], after, 0];
IF startOrder=before THEN { -- alpha start before beta start
alpha.start ← beta.start; alpha.end ← head.end
}
ELSE { -- beta start before alpha start
beta.start ← alpha.start; beta.end ← head.end
}
}
ELSE IF startOrder # endOrder THEN NULL -- one contained in the other
ELSE { --transpose head and tail
[] ← Transpose[world, alphaRoot, betaRoot, WholeNodeSpan[head], WholeNodeSpan[tail]];
IF startOrder=before THEN { -- alpha start before beta start
alpha.start ← beta.start; alpha.end ← head.end;
beta.start ← tail.start; beta.end ← alpha.end
}
ELSE { -- beta start before alpha start
beta.start ← alpha.start; beta.end ← head.end;
alpha.start ← tail.start; alpha.end ← beta.end
}
}
}
ELSE { -- do transpose as two moves
aSpan, bSpan: Span;
after1, after2: Location;
bLoc: Location ← NodeLoc[LastOfSlice[bBefore]];
aLoc: Location ← NodeLoc[LastOfSlice[aBefore]];
FreeSlices[];
aSpan ← NodeSpan[alpha.start.node, alpha.end.node];
bSpan ← NodeSpan[beta.start.node, beta.end.node];
[] ← MoveToLimbo[world, alphaRoot, aSpan]; after1 ← world.afterMoved1;
[] ← MoveToLimbo[world, betaRoot, bSpan]; after2 ← world.afterMoved1;
[] ← Move[world, betaRoot, Root[aSpan.start.node], bLoc, aSpan, after, bNesting];
[] ← Move[world, alphaRoot, Root[bSpan.start.node], aLoc, bSpan, after, aNesting];
world.afterMoved1 ← after1; world.afterMoved2 ← after2
}
};
IF TextLoc[alpha.start] AND TextLoc[beta.start] THEN { -- remerge starts
[alpha, beta] ← ReMerge[world, alpha, beta, alpha.start.node];
[alpha, beta] ← ReMerge[world, alpha, beta, beta.start.node]
};
IF TextLoc[alpha.end] AND TextLoc[beta.end] THEN { -- remerge ends
[alpha, beta] ← ReMerge[world, alpha, beta, alpha.end.node, TRUE];
[alpha, beta] ← ReMerge[world, alpha, beta, beta.end.node, TRUE];
afterAlphaLoc ← beta.end; afterBetaLoc ← alpha.end
};
world.afterMoved1 ← IF afterAlphaLoc.node=NIL THEN [beforeAlpha, 0] ELSE afterAlphaLoc; -- hint for repaint
world.afterMoved2 ← IF afterBetaLoc.node=NIL THEN [beforeBeta, 0] ELSE afterBetaLoc;
RETURN [alpha, beta]; 
EXITS ErrorReturn => {
FreeSlices[]; [alpha, beta] ← UndoSplits[world, alpha, beta];
ERROR CannotDoEdit
}
}
};
MoveOnto: PUBLIC PROC [world: World, destRoot, sourceRoot: Node, dest, source: Span, saveForPaste: BOOLTRUE] RETURNS [result: Span] = {
like Replace, but moves source instead of copying it
result is moved span
overlap: BOOL;
head, tail, newDest: Span; -- sections of alpha or beta before and after the overlap
startOrder, endOrder: Order;
aBefore, aAfter, aTop, aBottom, bBefore, bAfter, bTop, bBottom: Slice;
aNesting, bNesting: INT;
aDepth, bDepth: NAT;
FreeSlices: PROC = {
FreeSlice[aBefore]; FreeSlice[aAfter]; FreeSlice[aTop]; FreeSlice[aBottom];
FreeSlice[bBefore]; FreeSlice[bAfter]; FreeSlice[bTop]; FreeSlice[bBottom];
aBefore ← aAfter ← aTop ← aBottom ← bBefore ← bAfter ← bTop ← bBottom ← NIL
};
{ -- for exit
IF CheckForNil[source] OR CheckForNil[dest] THEN RETURN [nullSpan];
IF TextSpan[dest] AND TextSpan[source] THEN { -- pure text move
destText: Text ~ TextFromSpan[dest];
sourceText: Text ~ TextFromSpan[source];
IF saveForPaste THEN SaveTextForPaste[world, destText];
RETURN [SpanFromText[MoveTextOnto[world, destRoot, sourceRoot, destText, sourceText]]];
};
[dest, source] ← DoSplits[world, dest, source];
[aBefore, aAfter, aTop, aBottom, aNesting, aDepth] ←
DescribeBand[dest.start.node, dest.end.node ! BadBand =>
{ dest ← source ← nullSpan; GOTO ErrorReturn }];
[bBefore, bAfter, bTop, bBottom, bNesting, bDepth] ←
DescribeBand[source.start.node, source.end.node ! BadBand =>
{ dest ← source ← nullSpan; GOTO ErrorReturn }];
get slices for dest and source
[overlap, head, tail, startOrder, endOrder] ←
SliceOrder[dest, source, aBefore, aBottom, bBefore, bBottom];
FreeSlices[];
check for overlap
IF overlap THEN { -- bands overlap. modify dest so doesn't overlap
IF head = nullSpan AND tail = nullSpan THEN GOTO ErrorReturn;
IF head = nullSpan THEN { -- source start = dest start
IF endOrder=before THEN GOTO ErrorReturn -- dest end before source end
ELSE dest.start ← tail.start
}
ELSE IF tail = nullSpan THEN { --source end = dest end
IF startOrder=before THEN
dest.end ← head.end -- dest start before source start
ELSE GOTO ErrorReturn
} -- source start before dest start
ELSE { -- have both head and tail
IF startOrder=before AND endOrder=after THEN {
[] ← Delete[world, destRoot, tail]; dest.end ← head.end
}
ELSE IF startOrder=before THEN dest.end ← head.end
ELSE IF endOrder=after THEN dest.start ← tail.start
ELSE GOTO ErrorReturn
}
};
[dest, source] ← UndoSplits[world, dest, source];
source ← MoveToLimbo[world, sourceRoot, source];
sourceRoot ← Root[source.start.node];
[result, newDest] ← Transpose[world, sourceRoot, destRoot, source, dest];
IF saveForPaste THEN SaveSpanForPaste[world, newDest];
RETURN;
EXITS ErrorReturn => {
[dest, source] ← UndoSplits[world, dest, source]; ERROR CannotDoEdit
}
}
};
Nesting
ChangeNesting: PUBLIC PROC [world: World, root: Node, span: Span, change: INT] RETURNS [new: Span] = {
moves span to a deeper nesting level in tree
before, after, top, bottom: Slice;
nesting: INT;
depth: NAT;
FreeSlices: PROC = {
FreeSlice[before]; FreeSlice[after]; FreeSlice[top]; FreeSlice[bottom];
before ← after ← top ← bottom ← NIL
};
{ -- for exit
IF CheckForNil[span] THEN RETURN [nullSpan];
[span, ] ← DoSplits[world, span, nullSpan]; -- so can deal with entire nodes
DO -- only repeat this loop if have forced nest/unnest
[before, after, top, bottom, nesting, depth] ←
DescribeBand[span.start.node, span.end.node ! BadBand =>
{ span ← nullSpan; GOTO ErrorReturn } ];
IF nesting+change > 1 THEN GOTO ErrorReturn; -- cannot do it
SELECT NeedNestingChange[before, after, top, bottom, nesting+change, depth] FROM
needUnNest => {
afterNode: Node = LastOfSlice[after];
span: Span = NodeSpan[afterNode, LastWithin[afterNode]];
FreeSlices[];
[] ← UnNest[world, root, span];
LOOP
};
needNest => {
span: Span = NodeSpan[top[depth], LastWithin[bottom[depth]]];
IF SliceLength[top] = depth+1 THEN GOTO ErrorReturn;
FreeSlices[];
[] ← Nest[world, root, span];
LOOP;
};
ENDCASE => { -- do it
notify: REF NodeNesting Change;
notify ← NEW[NodeNesting Change ← [NodeNesting[
root, span.start.node, span.end.node, change]]];
EditNotify[world, notify, before];
DeletePrefix[top, depth];
DeletePrefix[bottom, depth];
ReplaceBand[before, after, top, bottom, nesting+change];
FreeSlices[];
EditNotify[world, notify, after];
NoteEvent[world, UndoChangeNesting, notify]
};
EXIT;
ENDLOOP;
RETURN [span];
EXITS ErrorReturn => {
FreeSlices[]; [span, ] ← UndoSplits[world, span, nullSpan]; ERROR CannotDoEdit
}
}
};
UndoChangeNesting: PROC [world: World, undoRef: REF Change] = {
WITH undoRef SELECT FROM
x: REF Change.NodeNesting => [] ← ChangeNesting[world, x.root, NodeSpan[x.first, x.last], -x.change];
ENDCASE => ERROR;
};
New nodes; split & merge
Insert: PUBLIC PROC [world: World, root, old: Node, where: Place ← after, inherit: BOOLTRUE] RETURNS [new: Node] = {
empty copy of old node is inserted in tree in position determined by "where"
IF old=NIL THEN RETURN [NIL];
new ← NewNode[];
IF inherit THEN Inherit[old: old, new: new];
DoInsertNode[world, root, old, new, where]
};
Inherit: PROC [old, new: Node, allprops: BOOLFALSE] = {
Copy: PROC [name: ATOM, value: REF] RETURNS [BOOL] = {
IF allprops OR Is[name, $Inheritable] THEN {
newvalue: REF ~ CopyProp[name, value];
IF newvalue#NIL THEN PutProp[new, name, newvalue];
};
RETURN [FALSE];
};
new.formatName ← old.formatName;
new.comment ← old.comment;
IF allprops OR old.hasprefix OR old.haspostfix OR old.hasstyledef THEN
[] ← MapProps[old, Copy, FALSE, FALSE];
};
DoInsertNode: PROC [world: World, root, old, new: Node, where: Place] = {
dest, parent: Node;
child: BOOL;
notify: REF InsertingNode Change;
IF new = NIL OR old = NIL THEN RETURN;
parent ← IF where = child THEN old ELSE Parent[old];
IF where = sibling THEN { dest ← LastWithin[old]; child ← FALSE }
ELSE IF where = after THEN { dest ← old; child ← FALSE }
ELSE IF where = child THEN { dest ← old; child ← TRUE }
ELSE {
IF parent.child = old THEN { dest ← parent; child ← TRUE }
ELSE { dest ← LastWithin[Previous[old, parent]]; child ← FALSE }
};
notify ← NEW[InsertingNode Change ← [InsertingNode[root, new, dest]]];
EditNotify[world, notify, before];
IF child THEN { -- insert as first child of dest
IF dest.child # NIL THEN { new.next ← dest.child; new.last ← FALSE }
ELSE { new.next ← dest; new.last ← TRUE };
dest.child ← new
}
ELSE IF where = sibling THEN { -- insert as next sibling of old; don't adopt children
new.next ← old.next; new.last ← old.last;
old.last ← FALSE; old.next ← new
}
ELSE { -- insert as next sibling of dest
new.next ← dest.next; new.last ← dest.last;
dest.last ← FALSE; dest.next ← new;
IF where = after AND (new.child ← dest.child) # NIL THEN { -- adopt dest's children
LastSibling[new.child].next ← new;
dest.child ← NIL
}
};
EditNotify[world, notify, after];
NoteEvent[world, UndoInsertNode, notify]
};
UndoInsertNode: PROC [world: World, undoRef: REF Change] = {
WITH undoRef SELECT FROM
x: REF Change.InsertingNode => [] ← Delete[world, x.root, NodeSpan[x.new, x.new]];
ENDCASE => ERROR
};
Split: PUBLIC PROC [world: World, root: Node, loc: Location] RETURNS [new: Node] = {
inserts copy of loc.node directly after loc.node (as sibling)
new adopts children of old (if any)
if loc.where # nodeItself and loc.node is a text node, then
text after loc.where moves to new node
text before loc.where stays in old node
returns the new node
IF loc.node=NIL THEN RETURN [NIL];
new ← Insert[world, root, loc.node, after];
IF TextLoc[loc] THEN {
[] ← MoveText[world, root, root, [new, 0], [loc.node, loc.where, maxLen]];
}
};
Merge: PUBLIC PROC [world: World, root, node: Node] RETURNS [loc: Location] = {
copies text of node to end of previous node
then deletes node
returns location of join in the merged node
pred: Node ~ StepBackward[node];
IF pred=NIL OR Parent[pred]=NIL OR node=NIL THEN ERROR CannotDoEdit
ELSE {
result: Text ~ CopyText[world, root, root, [pred, maxLen], [node, 0, maxLen]];
[] ← Delete[world, root, NodeSpan[node, node]];
RETURN [[result.node, result.start]];
};
};
Change looks
ChangeLooks: PUBLIC PROC [world: World, root: Node, span: Span, remove, add: Looks] = {
DoChange: PROC [node: Node, start, len: INT] RETURNS [stop: BOOL] = {
ChangeTextLooks[world, root, [node, start, len], remove, add]; RETURN [FALSE]
};
ApplyToSpan[span, DoChange];
};
Caps and Lowercase
ChangeCaps: PUBLIC PROC [world: World, root: Node, span: Span, how: CapChange ← allCaps] = {
DoChange: PROC [node: Node, start, len: INT] RETURNS [stop: BOOL] = {
ChangeTextCaps[world, root, [node, start, len], how]; RETURN [FALSE]
};
IF CheckForNil[span] THEN RETURN;
ApplyToSpan[span, DoChange];
};
END.