TiogaNodeOpsImpl.mesa; Written by S. McGregor, February 1983
Edited by Paxton, August 30, 1983 9:40 am
Edited by McGregor, August 12, 1983 11:09 am
DIRECTORY
MonitoredQueue,
NodeProps,
Process,
RopeFrom,
TiogaLocks,
TiogaLooks,
TiogaLooksOps,
TiogaNode,
TiogaItemClass,
TiogaBasicClass,
TiogaNodeOps,
Rope,
RopeEdit;
TiogaNodeOpsImpl: CEDAR PROGRAM
IMPORTS MonitoredQueue, NodeProps, Process, RopeEdit, RopeFrom, TiogaLocks, TiogaLooksOps
EXPORTS TiogaNodeOps
SHARES TiogaNode =
BEGIN OPEN TiogaNodeOps, TiogaNode, TiogaItemClass, TiogaBasicClass;
ROPE: TYPE = Rope.ROPE;
***** Item Class registration
ItemClasses: TYPE = RECORD[SEQUENCE maxItems: ItemClassID OF ItemClass];
items: REF ItemClasses ← NEW[ItemClasses[4]];
itemsRegistered: ItemClassID ← 0;
RegisterItemClass: PUBLIC PROC [classRec: ItemClassRec, OKToOverwritePrevious: BOOL --← FALSE--] RETURNS [ItemClassID] = BEGIN
class: ItemClass ← NEW[ItemClassRec ← classRec];
FOR i: ItemClassID IN [0..itemsRegistered) DO
IF items[i].flavor=classRec.flavor THEN BEGIN --re-registration
IF NOT OKToOverwritePrevious THEN ERROR;
items[i] ← class;
RETURN [i];
END;
ENDLOOP;
IF itemsRegistered >= items.maxItems THEN BEGIN   -- expand class array
newItems: REF ItemClasses;
IF itemsRegistered+1 >= invalidItemID THEN ERROR; -- too many items registered
newItems ← NEW[ItemClasses[items.maxItems*2]];
FOR i: ItemClassID IN [0..itemsRegistered) DO
newItems[i] ← items[i];
ENDLOOP;
items ← newItems;
END;
items[itemsRegistered] ← class;
itemsRegistered ← itemsRegistered+1;
RETURN[itemsRegistered-1];
END;
LookupItemID: PUBLIC PROC [flavor: ItemFlavor, buildNewClassIfLookupFails: BOOL --← FALSE--] RETURNS [ItemClassID] = BEGIN
the ItemClassID could be saved on the atom property list if this search is too slow
FOR i: ItemClassID IN [0..itemsRegistered) DO
IF items[i].flavor=flavor THEN RETURN [i];
ENDLOOP;
IF buildNewClassIfLookupFails THEN ERROR; --Sorry, not yet implemented.
RETURN[invalidItemID];
END;
FetchItemClass: PUBLIC PROC [id: ItemClassID] RETURNS [ItemClass] = BEGIN
RETURN[IF id>=itemsRegistered THEN NIL ELSE items[id]];
END;
***** Basic Class registration
BasicClasses: TYPE = RECORD[SEQUENCE maxBasics: BasicClassID OF BasicClass];
basics: REF BasicClasses ← NEW[BasicClasses[4]];
basicsRegistered: BasicClassID ← 0;
RegisterBasicClass: PUBLIC PROC [classRec: BasicClassRec, OKToOverwritePrevious: BOOL --← FALSE--] RETURNS [BasicClassID] = BEGIN
class: BasicClass ← NEW[BasicClassRec ← classRec];
FOR i: BasicClassID IN [0..basicsRegistered) DO
IF basics[i].flavor=classRec.flavor THEN BEGIN -- re-registration
IF NOT OKToOverwritePrevious THEN ERROR;
basics[i] ← class;
RETURN [i];
END;
ENDLOOP;
IF basicsRegistered >= basics.maxBasics THEN BEGIN   -- expand class array
newBasics: REF BasicClasses;
IF basicsRegistered+1 >= invalidBasicID THEN ERROR; -- too many basics registered
newBasics ← NEW[BasicClasses[basics.maxBasics*2]];
FOR i: BasicClassID IN [0..basicsRegistered) DO
newBasics[i] ← basics[i];
ENDLOOP;
basics ← newBasics;
END;
basics[basicsRegistered] ← class;
basicsRegistered ← basicsRegistered+1;
RETURN[basicsRegistered-1];
END;
LookupBasicID: PUBLIC PROC [flavor: BasicFlavor, buildNewClassIfLookupFails: BOOL --← FALSE--] RETURNS [BasicClassID] = BEGIN
the BasicClassID could be saved on the atom property list if this search is too slow
FOR i: BasicClassID IN [0..basicsRegistered) DO
IF basics[i].flavor=flavor THEN RETURN [i];
ENDLOOP;
IF buildNewClassIfLookupFails THEN ERROR; --Sorry, not yet implemented.
RETURN[invalidBasicID];
END;
FetchBasicClass: PUBLIC PROC [id: BasicClassID] RETURNS [BasicClass] = BEGIN
RETURN[IF id>=basicsRegistered THEN NIL ELSE basics[id]];
END;
***** Node creation
NewBranchNode: PUBLIC PROC RETURNS [br: RefBranchNode] = BEGIN
br ← NEW[branch Node];
br.last ← TRUE;
END;
NewTextNode: PUBLIC PROC [class: ItemClassID] RETURNS [tx: RefTextNode] = BEGIN
itemClass: TiogaItemClass.ItemClass ← FetchItemClass[class];
tx ← NEW[text item Node];
tx.last ← TRUE;
tx.class ← class;
IF itemClass.init#NIL THEN itemClass.init[tx];
END;
NewListNode: PUBLIC PROC [class: ItemClassID] RETURNS [ls: RefListNode] = BEGIN
itemClass: TiogaItemClass.ItemClass ← FetchItemClass[class];
ls ← NEW[list item Node];
ls.last ← TRUE;
ls.class ← class;
IF itemClass.init#NIL THEN itemClass.init[ls];
END;
NewBoxNode: PUBLIC PROC [class: ItemClassID] RETURNS [bx: RefBoxNode] = BEGIN
itemClass: TiogaItemClass.ItemClass ← FetchItemClass[class];
bx ← NEW[box item Node];
bx.last ← TRUE;
bx.class ← class;
IF itemClass.init#NIL THEN itemClass.init[bx];
END;
NewBasicNode: PUBLIC PROC [class: BasicClassID] RETURNS [bs: RefBasicNode] = BEGIN
basicClass: TiogaBasicClass.BasicClass ← FetchBasicClass[class];
bs ← NEW[basic Node];
bs.last ← TRUE;
bs.class ← class;
IF basicClass.init#NIL THEN basicClass.init[bs];
END;
***** Text node operations
Fetch: PUBLIC PROC [text: RefTextNode, index: Offset] RETURNS [CHAR, TiogaLooks.Looks] = {
fetches the indexed information
use readers if want info from contiquous locations
RETURN [RopeEdit.Fetch[text.rope,index], TiogaLooksOps.FetchLooks[text.runs,index]] };
FetchChar: PUBLIC PROC [text: RefTextNode, index: Offset] RETURNS [CHAR] = {
fetches the indexed information
use readers if want info from contiquous locations
RETURN [RopeEdit.Fetch[text.rope,index]] };
FetchLooks: PUBLIC PROC
[text: RefTextNode, index: Offset] RETURNS [TiogaLooks.Looks] = {
returns the looks for the character at the given location
use reader's if getting looks for sequence of locations
RETURN [TiogaLooksOps.FetchLooks[text.runs,index]] };
GetRope: PUBLIC PROC [text: RefTextNode] RETURNS [ROPE] =
{ RETURN [IF text=NIL THEN NIL ELSE text.rope] };
GetRuns: PUBLIC PROC [text: RefTextNode] RETURNS [TiogaLooks.Runs] =
{ RETURN [IF text=NIL THEN NIL ELSE text.runs] };
Size: PUBLIC PROC [text: RefTextNode] RETURNS [Offset] =
{ RETURN [IF text=NIL THEN 0 ELSE RopeEdit.Size[text.rope]] };
***** Operation to free a tree by clearing all REF's
treeQueue: MonitoredQueue.MQ ← MonitoredQueue.Create[];
FreeTree: PUBLIC PROC [root: RefBranchNode] = {
IF root=NIL OR root.deleted THEN RETURN;
root.deleted ← TRUE;
FOR event: EditEvent ← editEvent.next, event.next UNTIL event = editEvent DO
FOR sub: UndoEvent.SubEvent ← editEvent.undo.subevents, sub.next UNTIL sub=NIL DO
IF sub.undoRef # NIL THEN WITH sub.undoRef SELECT FROM
x: REF UndoEvent.Change.ChangingText => IF x.root = root THEN RETURN;
x: REF UndoEvent.Change.ChangingProp => IF x.root = root THEN RETURN;
x: REF UndoEvent.Change.MovingNodes => IF x.destRoot = root OR x.sourceRoot = root THEN RETURN;
x: REF UndoEvent.Change.NodeNesting => IF x.root = root THEN RETURN;
x: REF UndoEvent.Change.InsertingNode => IF x.root = root THEN RETURN;
ENDCASE;
ENDLOOP;
ENDLOOP;
MonitoredQueue.Add[root, treeQueue] };
FreeTrees: PROC = {
DO -- forever
tree: REF ANY ← MonitoredQueue.Remove[treeQueue];
DoFreeTree[NARROW[tree] ! ABORTED => CONTINUE];
ENDLOOP };
nodesFreed: INT ← 0;
DoFreeTree: PROC [root: RefBranchNode] = {
itemClassID: ItemClassID ← 0;
itemClass: TiogaItemClass.ItemClass ← FetchItemClass[itemClassID];
basicClassID: BasicClassID ← 0;
basicClass: TiogaBasicClass.BasicClass ← FetchBasicClass[basicClassID];
DestroyItem: PROC [item: RefItemNode] = INLINE {
IF item.class # itemClassID THEN
itemClass ← FetchItemClass[itemClassID ← item.class];
IF itemClass.destroy # NIL THEN itemClass.destroy[item] };
DestroyBasic: PROC [basic: RefBasicNode] = INLINE {
IF basic.class # basicClassID THEN
basicClass ← FetchBasicClass[basicClassID ← basic.class];
IF basicClass.destroy # NIL THEN basicClass.destroy[basic] };
next, node: Ref;
IF root.child = NIL THEN RETURN; -- has already been freed
TRUSTED {Process.SetPriority[Process.priorityBackground]}; -- no rush to finish this
Process.Yield[];
[] ← TiogaLocks.Lock[root, "DoFreeTree", write]; -- must make sure no one still reading it. never unlock it.
node ← root; next ← NIL;
DO -- go through the tree zapping REF's
WITH node SELECT FROM
br: RefBranchNode =>
IF br.contents # NIL THEN { next ← br.contents; br.contents ← NIL }
ELSE { next ← br.child; br.child ← NIL };
bx: RefBoxNode => next ← bx.contents;
ls: RefListNode => next ← ls.contents;
ENDCASE;
IF next # NIL THEN { node ← next; next ← NIL; LOOP };
next ← node.next; node.next ← NIL; node.last ← node.deleted ← TRUE;
The node has now been removed from the tree and its contents have been destroyed.
WITH node SELECT FROM
tx: RefTextNode => { DestroyItem[tx]; tx.rope ← NIL; tx.runs ← NIL };
bx: RefBoxNode => { DestroyItem[bx]; bx.data ← NIL };
ls: RefListNode => { DestroyItem[ls]; ls.data ← NIL };
bc: RefBasicNode => { DestroyBasic[bc]; bc.data ← NIL };
ENDCASE;
IF node.hasPropList THEN NodeProps.RemProps[node];
nodesFreed ← nodesFreed+1;
IF (node ← next) = NIL THEN EXIT;
ENDLOOP };
***** Operations to create a text node from a rope or a string
FromRope: PUBLIC PROC [rope: ROPE, class: ItemClassID ← defaultTextClassID]
RETURNS [new: RefTextNode] = {
create a text node with looks from a normal rope
new ← NewTextNode[class];
new.rope ← rope; new.last ← TRUE;
new.runs ← TiogaLooksOps.CreateRun[RopeEdit.Size[rope]] };
FromString: PUBLIC PROC [
string: REF READONLY TEXT, class: ItemClassID ← defaultTextClassID]
RETURNS [new: RefTextNode] = {
copies the contents of the string
new ← NewTextNode[class]; new.last ← TRUE;
new.rope ← RopeFrom.String[string];
new.runs ← TiogaLooksOps.CreateRun[RopeEdit.Size[new.rope]] };
***** Operation to create a document from an item node
DocFromNode: PUBLIC PROC [child: RefItemNode] RETURNS [root: RefBranchNode] = {
br: TiogaNode.RefBranchNode ← NewBranchNode[];
root ← NewBranchNode[];
root.child ← br; root.last ← TRUE;
br.contents ← child; br.last ← TRUE; br.next ← root;
child.last ← TRUE; child.next ← br;
};
***** Miscellaneous
MakeNodeLoc: PUBLIC PROC [n: Ref] RETURNS [Location] = { RETURN [[[n, NIL], NodeItself]] };
MakeNodeSpan: PUBLIC PROC [first, last: Ref] RETURNS [Span] = {
RETURN [[MakeNodeLoc[first], MakeNodeLoc[last]]] };
EndPos: PUBLIC PROC [n: RefTextNode] RETURNS [Offset] =
{RETURN[IF n=NIL THEN 0 ELSE MAX[RopeEdit.Size[n.rope],1]-1]};
END.