{*************************************************************************
 ***                                                                   ***
 ***           1D-2D (CHAIN & TREE) OBJECTS, VIEWERS & STREAMS         ***
 ***                                                             Nov 93***
 ***MCH                                                      rev Apr 96***
 *************************************************************************}
{$I compflgs}

unit LinkList;

INTERFACE

uses objects, drivers,
{$IFDEF WINDOWS}
	wuilist,	{windows}
{$ELSE}
	tuilist, {text}
{$ENDIF}
			files, {for streaming}
			tasks; {for lists tasks}

type
	{--- 2d nodes ------}
	PNode = ^TNode;
	TNode = object(TDataItem)

		Next : PNode;
		Prev : PNode;
		Child : PNode;
		Parent : PNode;

		NextID : longint;
		PrevID : longint;
		ChildID : longint;

		Expanded : boolean; {display children}

		constructor Init;
		procedure CommonInit; virtual;
		destructor Done; virtual;

		constructor Load(Var S : TStream);
		procedure Store(Var S : TStream);
		function GetKey : longint; virtual;          {For sorting}
	end;

	PChainStream = ^TChainStream;
	TChainStream = object(TDataStream)

		{at the moment, just chain (ie 1d trees) methods}
		procedure Insert(var FirstNodeID : longint; const NewNode : PNode; const Bias : boolean);  {Inserts new record}
		procedure DeleteLink(var FirstNodeID : longint; RecNo : longint); virtual;

		procedure PutNext(var RecNo : longint; Node : PNode; More : boolean);
		function GetNext(var RecNo : longint) : PNode;

		{make sure actionproc/testfunc are far, local, and remember (for the
		jimmy files) that they expect a *hook/node* as a parameter, not a jimmy}
		procedure ForEach(RootNodeID : longint; ActionProc : pointer); {make sure action proc  is far}
		function FirstThat(RootNodeID : longint; TestFunc : pointer) : PNode; {make sure test func is far}
	end;{}

	PNodeStream = ^TNodeStream;
	TNodeStream = object(TChainStream)

		LastParentID : longint; {stores parent of last firstthat search, handy
		for inserts/deletes}

		{at the moment, just adds proper tree-foreach stuff}
		procedure ForEach(RootNodeID : longint; ActionProc : pointer); {make sure action proc  is far}
		function FirstThat(RootNodeID : longint; TestFunc : pointer) : PNode; {make sure test func is far}
	end;{}

	{******************************
	 ***       TREE TYPE        ***
	 ******************************}
	 {used for invoices, etc, which use trees, providing a quick and easy
	 access point to loading & processing tree as a whole}

{	TTreeForEachAction = procedure(Node : PNode);{}

	PTree = ^TTree;
	TTree = object(TObject)
		RootNode : PNode;

		{for loadtree & storetree}
		fitype : word;
		Loaded : boolean;

		WorkFromDisk : boolean;
		RootNodeID : longint;

		constructor Init;
		destructor Done; virtual;

		procedure LoadTree;
		procedure StoreTree;
{		procedure StoreBranch(Node : PNode);
{		function LoadBranch(var RootID : longint; ParentNode : PNode) : PNode;{}

		procedure ForEach(ActionProc : pointer); {make sure action proc  is far}
		function FirstThat(TestFunc : pointer) : PNode; {make sure test func is far}
		procedure ReOrder(KeyFunc : pointer); {re-orders using function KeyFunc, same as TestFunc but returning a longint}
		procedure ReverseOrder; {re-orders in reverse}

		procedure InsertChild(const Node, ParentNode : PNode);
		procedure InsertPeer(const Node, PeerNode : PNode);

		procedure DeleteNode(Node : PNode);
		procedure DetachNode(Node : PNode);

		procedure DetachChildTree(ParentNode : PNode; var ChildTree : PNode);
		procedure AttachChildTree(ChildTree, ParentNode : PNode);

		{for treating the tree as a 0-based index}
		{children are listed directly after parents}
		{does not count children of un-expanded nodes}
		function IndexAt(Node : PNode) : word;
		function NodeAt(Index : word) : PNode;
		function NumNodes : integer;{}
	end;

{function GetRootNode(Node : PNode) : PNode;

procedure AttachTree2Node(Tree, Node : PNode);

function PrintTree(prType : word; Output : POutputStream; Node : PNode) : word;  {prints self, peers and children}

	{**********************************
	 ***       NODE COLLECTION      ***
	 **********************************}
{descendants should add GetText, Edit and EditNew functions (at least!),
 and either GetData, SetData, etc or GetOwnersRoot/SetOWnersRoot}
	{--- LIST INTERIOR ---}
	PNodeView   = ^TNodeView;          {Interior}
	TNodeView    = object(TListView)

		Tree : PTree;
		ChainOnly : boolean; {mark as 1 dimension allowed only - ie chain}


		constructor Init(var Bounds: TRect;
										 NlsType : word);
		destructor Done; virtual;

		procedure DoStartUp; virtual;

		procedure FocusNode(Node : PNode); virtual;
		procedure HandleEvent(var Event : TEvent); virtual;{}

		function  TreeLines(Node : PNode)  : string; virtual;
		function 	AddTreeLines(Node : PNode; S : string) : string;

		procedure Del(ItemNo : LongInt); virtual; {}

		function  GetText(const ItemNo: longint) : string; virtual; {for display}
		procedure SetRange; virtual;
		procedure LoadTree;

{		procedure Redraw; virtual;{}

		procedure SetOwnersRoot; virtual; {Set's Node owner's pointer to first in Node}
		function GetOwnersRoot : longint; virtual;{}

	end;


IMPLEMENTATION

uses global, {cm commands}
{			clipbrd,{}
			help,
			views, {sfxxx}
			minilib,
			tuimsgs,
			app; {more cm commands}

{****************************************************
 ***                                              ***
 ***            NODE ITEM                         ***
 ***                                              ***
 ****************************************************}

constructor TNode.Init;
begin
	inherited Init;

	NextID := -1;
	PrevID := -1;
	ChildID := -1;

	CommonInit;
end;

procedure TNode.CommonInit; {Initialise non-file items}
begin
	Next := nil;
	Prev := nil;
	Child := nil;
	Parent := nil;

	Expanded := True;

	RecNo := -1;
end;

destructor TNode.Done;
begin
	{dispose of child & peer - effectively disposes of whole tree from this point}

	{leave it to the caller to make sure any subtrees are detached that
	should not be disposed of}
	if Child<>nil then dispose(Child, done);
	if Next <>nil then dispose(Next, done);{}

	inherited done;
end;

{*****************************
 ***     STREAM FUNCTIONS  ***
 *****************************}

constructor TNode.Load(var S : TStream);
begin
	CommonInit;

	S.Read(NextID, 4);
	S.Read(PrevID, 4);
	S.Read(ChildID, 4);

	S.Read(Expanded, 1);
end;

procedure TNode.Store(var S : TStream);
begin
	S.Write(NextID, 4);
	S.Write(PrevID, 4);
	S.Write(ChildID, 4);

	S.Write(Expanded, 1);
end;

function TNode.GetKey;
begin GetKey := 0; end;


{*******************************************************
 ***                                                 ***
 ***               TREE                              ***
 ***                                                 ***
 *******************************************************}
constructor TTree.init;
begin
	inherited Init;
	RootNode := nil;

	RootNodeID := -1;
	Loaded := True; {nothing to load}
	fiType := 0;

	WorkFromDisk := False;
end;

destructor TTree.Done;
begin
	if RootNode<>nil then dispose(RootNode, done);
	inherited Done;
end;

{**************************************
 ***       FILE OPERATIONS          ***
 **************************************}

procedure TTree.StoreTree;

	{recursive part of storetree}
	procedure StoreBranch(Node : PNode);
	var RecNo : longint;
			PrevNode : PNode;
	begin
		{Store all peers.  Follow disk peers until no more, then add on end}

		while Node<>nil do begin

			{store children}
			if Node^.Child<>nil then begin
				StoreBranch(Node^.Child); {store children}
				Node^.ChildID := Node^.Child^.RecNo;
			end else
				Node^.ChildID := -1; {set next pointer to nil}

			{set pointers}
			if Node^.Prev<>nil then Node^.PrevID := Node^.Prev^.RecNo else Node^.PRevID := -1;
			if (Node^.Next<>nil) and (Node^.Next^.REcNO<>-1) then
				Node^.NextID := Node^.Next^.REcNo
			else
				Node^.NextID := -1; {can't set this yet if it's new as there may be
														children to be stored first...}

			{new one -add to end}
			if Node^.recNo = -1 then begin
				Node^.RecNo := Stream(fiType)^.NoRecs;
				if Node^.PrevID<>-1 then begin
					{and set prev pointer if new, as it was not set above}
					PrevNode := PNode(Stream(FiType)^.GetAt(Node^.PrevID)); {also sets recno}
					PrevNode^.NextID := Node^.RecNo;
					Stream(fiType)^.PutAt(PrevNode^.recno, PrevNode);
					dispose(PrevNode, done);
				end;
			end;

			Stream(fiType)^.PutAt(Node^.RecNo, Node);
			Node := Node^.Next;
		end;
	end;


begin
	ThinkingOn('Storing Tree');
	if RootNode<>nil then begin
		FileAdmin(fiType)^.LogOn;
		{$IFNDEF SingleUser} Stream(fiType)^.Flush; {$ENDIF} {clear buffers so we are reading from latest disk info}
		StoreBranch(RootNode);
		{$IFNDEF SingleUser} Stream(fiType)^.Flush; {$ENDIF} {clear buffers so we are reading from latest disk info}
		FileAdmin(fiType)^.LogOff;
		RootNodeID := RootNode^.RecNo;
	end else
		RootNodeID := -1;
	ThinkingOff;
end;

{==== Store Branch ===========}

procedure TTree.LoadTree;

	{==== Load Branch ============}
	{if you do recursive load on the next one, hit snag of stack overflow on long
	lists due to recursive loadtree for peers - should really only be recursive
	for children...}
	{recursive part to loadtree}
	function LoadBranch(var RootID : longint; ParentNode : PNode) : PNode;
	var WorkNode,PrevNode : PNode;
			WorkRec : longint;

	begin
		PrevNode := nil;
		WorkNode := nil;
		WorkRec := RootID;
		LoadBranch := nil;

		{can we use the foreach of the stream for this?}
	{	PNodeStream(Stream(fiType))^.ForEach(RootID, LoadNode);

		{get first and peers}
		while WorkRec >-1 do begin

			PrevNode := WorkNode;
			WorkNode := PNode(Stream(fiType)^.GetAt(WorkRec));

{writeln('P'+N2Str(WorkNode^.PrevID)+' ID'+N2Str(WorkRec)+' N'+N2Str(WorkNode^.NextID));
DebugNote('P'+N2Str(WorkNode^.PrevID)+' ID'+N2Str(WorkRec)+' N'+N2Str(WorkNode^.NextID));
if KeyPressed then halt(0);{}

			{safety}
			if WorkNode = nil then begin
				DBaseMessage(@Self, 'Could not get node '+N2Str(WorkRec)+#13
														+'TTree.LoadBranch.  Truncating',mferror, hcInternalErrorMsg);
				if PrevNode<>nil then PrevNode^.NextID := -1 else if ParentNode<>nil then ParentNode^.ChildID := -1;
				exit; {finish - loadtree is nil above}
			end;

			{add to tree}
			if PrevNode = nil then begin
				LoadBranch := WorkNode; {first in this level of chain}
				WorkNode^.Parent := ParentNode; {insertpeer will then set parent ptrs of all peers}
			end else
				InsertPeer(WorkNode, PrevNode); {adds worknode to follow on after prevnode}

			{Get children}
			if WorkNode^.ChildID <> -1 then
				WorkNode^.Child := LoadBranch(WorkNode^.ChildID, WorkNode);

			WorkRec := WorkNode^.NextID;
		end;
	end;


begin
	if RootNode<>nil then dispose(RootNode, done);  {dispose of existing tree}

	if RootNodeID=-1 then
		{saves logging onto stream, etc}
		RootNode := nil
	else begin
		ThinkingOn('Loading Tree');
		FileAdmin(fiType)^.LogOn;
		{$IFNDEF SingleUser} Stream(fiType)^.Flush; {$ENDIF} {clear buffers so we are reading from latest disk info}

		RootNode := LoadBranch(RootNodeID, nil);
		FileAdmin(fiType)^.LogOff;
		ThinkingOff;
	end;

	Loaded := True;
end;


{****************************************
 ***          TREE PROCESSING         ***
 ****************************************}
{OK, this caused a lot of fun.  These sub methods (ie DoNode) need to have
access to their parent procedure, and normally this happens quite happily
with the compiler automatically sorting things out for you.

However, the TestFunc and ActionProc want to refer to *their* parent, and
there the compiler fouls up, as it assumes the DoNode is the parent.  So
what we have to do is store the stackframe of, say, the testfunc's parent
(which is the previous stackframe as it's just called this procedure), then
push that onto the stack as the last item before calling TestFunc.

As we have to do this via assembly, we suddenly can't use the compiler to
access the DoNode parent's (eg Foreach) variables.  We can either write
some proper assembly to deal with that, or just set some local variables
(ie W & P below) and use the compiler to set them, then use *them* in
the assembly code.  Seems to work}

function TTree.FirstThat;
var StackFrame : word;

	{recursive part}
	function DoNode(Node : PNode) : PNode;
	var FoundNode : PNode;
			FOund : boolean;
			W : word;
			P : pointer;

	begin
		FoundNode := nil;
		while (FoundNode=nil) and (Node<>nil) do begin

			{See comments above}
			{Convert parent's stuff to local}
			W := StackFrame;
			P := TestFunc;

			{call testfunc with testfunc's parent's stack}
			asm
				LES     DI,Node       {put node parameter onto stack}
				PUSH    ES
				PUSH    DI

				PUSH		W							{put testfunc's parent's stack frame onto stack}

				CALL    P            	{call testFunc}
				MOV			Found,AL			{load answer from AL}
			end;

			if Found then
				FoundNode := Node
			else begin
				if (Node^.Expanded) and (Node^.Child<>nil) then FoundNode := DoNode(Node^.Child); {do children}
				Node := Node^.Next;
			end;
		end;

		DoNode := FoundNode;
	end;


begin
	{store caller's stack frame so it's local proc can use it}
	asm
		PUSH WORD PTR [BP]
		POP StackFrame
	end;{}

	FirstThat := DoNode(RootNode); {start at root}
end;


procedure TTree.ForEach;
var StackFrame : word;

	{recursive part}
	procedure DoNode(Node : PNode);
	var	W : word;
			P : pointer;

	begin
		while (Node<>nil) do begin

			{See comments above}
			{Convert parent's stuff to local}
			W := StackFrame;
			P := ActionProc;

			{call testfunc with testfunc's parent's stack}
			asm
				LES     DI,Node       {put node parameter onto stack}
				PUSH    ES
				PUSH    DI

				PUSH		W							{put testfunc's parent's stack frame onto stack}

				CALL    P            	{call testFunc}
			end;

			if (Node^.Expanded) and (Node^.Child<>nil) then DoNode(Node^.Child); {do children}
			Node := Node^.Next;
		end;
	end;

begin
	{store caller's stack frame so it's local proc can use it}
	asm
		PUSH WORD PTR [BP]
		POP StackFrame
	end;{}

	DoNode(RootNode); {start at root}
end;

{***************************************
 ***      RE ORDER                   ***
 ***************************************}
{Re-order tree as given by KeyFunc.  Note
that after this is done, any inserting will
be out of order as the insert method uses the
nodes' keys}

procedure TTree.ReOrder;
var TempRoot : PNode; {makes a temporary no-peer root}
		StackFrame : word;

	function GetKey(Node : PNode) : longint;
	var W : word;
			P : pointer;
			Key : TLongWord;

	begin
		W := StackFrame;
		P := KeyFunc;

		asm
			LES     DI,Node       {put node parameter onto stack}
			PUSH    ES
			PUSH    DI
			PUSH		W							{put testfunc's parent's stack frame onto stack}
			CALL    P            	{call testFunc}
			MOV			Key.Lo,AX			{load answer from AX}
			MOV 		Key.Hi,DX				{load high word from DX}
		end;

		GetKey := longint(Key);
	end;



	procedure OrderChildren(Parent : PNode);
	var FirstChild,Work,Next,Prev : PNode;
			WorkKey,NodeKey : longint;
	begin
		FirstCHild := Parent^.Child;
		Parent^.Child := nil; {Clear}

		while FirstChild<>nil do begin
			{separate off first one}
			Next := FirstChild^.Next;
			if Next<>nil then Next^.Prev := nil;
			FirstChild^.Next := nil;

			if FirstChild^.Child<>nil then OrderChildren(FirstChild);

			{get first one's key - see comments above}
			NodeKey := GetKey(FirstChild);

			if Parent^.Child=nil then
				Parent^.Child := FirstChild
			else begin
				{sort}
				Work := Parent^.Child;
				Prev := nil;

				{find insert position}
				while (Work<>nil) and (NodeKey >= GetKey(Work)) do begin
					Prev := Work;
					Work := Work^.Next;
				end;

				{insert into parent's children}
				if (Prev = nil) then begin
					{first in list}
					FirstChild^.Next := Parent^.Child;
					FirstChild^.Parent^.Child := FirstChild;
					FirstChild^.Next^.Prev := FirstChild;
				end else
					InsertPeer(FirstChild, Prev);
			end;

			FirstChild := Next;
		end;
	end;

begin
	if RootNode=nil then exit;

	{store caller's stack frame so it's local proc can use it}
	asm
		PUSH WORD PTR [BP]
		POP StackFrame
	end;{}

	New(TempRoot, init);
	AttachChildTree(RootNode, TempRoot); {attaches tree to temporary root}

	OrderChildren(TempRoot);
	RootNode := TempRoot^.Child;
	RootNodeID := RootNode^.RecNo;

	DetachChildTree(TempRoot, RootNode); {detach tree}
	dispose(TempRoot, done);
end;

{---- Reverse Order -----}
{this will *really* reverse it, according to the way re-order works
at the moment.  Who knows, might be useful...}
procedure TTree.ReverseOrder;
var L : longint;

	function ReKey(Node : PNode) : longint;
	begin
		ReKey := L;
		inc(L);
	end;

begin
	L := 0;
	ReOrder(@ReKey);
end;



{***************************************
 ***       GRAFTING & PRUNING (!)    ***
 ***************************************}

procedure TTree.InsertChild(const Node, ParentNode : PNode);
var Work,Prev : PNode;
begin
	if (Node = nil) or (ParentNode = nil) then exit; {shouldn't be called...}

	if ParentNode^.Child = nil then
		ParentNode^.Child := Node
	else begin
		{run through chain of parentnode's children, finding insert position}
		Work := ParentNode^.Child;
		Prev := nil;

		while (Work<>nil) and (Node^.GetKey >= Work^.GetKey) do begin
			Prev := Work;
			Work := Work^.Next;
		end;

		if (Prev = nil) then begin
			{first in list}
			Node^.Next := ParentNode^.Child;
			Node^.Parent^.Child := Node;
			Node^.Next^.Prev := Node;
		end else
			InsertPeer(Node, Prev);

	end;

	Node^.Parent := ParentNode;
end;

procedure TTree.InsertPeer(const Node, PeerNode : PNode);
begin
	{inserts just after peernode}
	Node^.Parent := PeerNode^.Parent;
	Node^.Next := PeerNode^.Next;
	Node^.Prev := PeerNode;

	PeerNode^.Next := Node;
	if Node^.Next<>nil then Node^.Next^.Prev := Node;
end;


procedure TTree.DeleteNode(Node : PNode);
begin
	DetachNode(Node);
	dispose(Node, done);
end;

{attaches a tree, which may have several peer items to the root,
as a child to a node}
procedure TTree.AttachChildTree(ChildTree, ParentNode : PNode);
begin
	ParentNode^.Child := ChildTree;
	{set parentage}
	while ChildTree<>nil do begin
		ChildTree^.Parent := ParentNode;
		ChildTree := ChildTree^.next;
	end;
end;

procedure TTree.DetachChildTree(ParentNode : PNode; var ChildTree : PNode);
var WorkNode : PNode;
begin
	ChildTree := ParentNode^.Child;
	ParentNode^.Child := nil;

	{clear parentage}
	WorkNode := ChildTree;
	while WorkNode<>nil do begin
		WorkNode^.Parent := nil;
		WorkNode := WorkNode^.Next;
	end;
end;

procedure TTree.DetachNode;
begin
	{remove from peer chain}
	{note this does not update disk pointers}

	if Node^.Prev <> nil then Node^.Prev^.Next := Node^.Next; {set prev's pointer to bypass}
	if Node^.Next <> nil then Node^.Next^.Prev := Node^.Prev;

	{if nec, set parent's pointer to next one}
	if (Node^.Parent <> nil) and (Node^.Parent^.Child = Node) then
			Node^.Parent^.Child := Node^.Next;

	if RootNode = Node then RootNode := Node^.Next;

	{Clear in case del is used for "cut" - so that reconnections are not confused}
	Node^.Prev := nil;
	Node^.Next := nil;{}
	Node^.Parent := nil;
end;


{find list position of node if tree is laid out one node after the other}
function TTree.IndexAt(Node : PNode) : word;
var W : word;

	procedure Look(N : PNode);
	begin
		while (N<>nil) and (N<>Node) do begin
			inc(W);
			if N^.Expanded and (N^.Child<>nil) then Look(N^.Child);
			N := N^.Next;
		end;
	end;

begin
	W := 0;
	Look(RootNode);{}
	IndexAt := W;{}
end;


function TTree.NumNodes : integer;{}
begin
	NumNodes := IndexAt(nil);
end;


function TTree.NodeAt(Index : word) : PNode;
var WorkIndex : word;

	procedure Find(N : PNode); far;
	begin
		while (N<>nil) and (WorkIndex<=Index) do begin
			if WOrkIndex = Index then begin
				NodeAt := N;
				inc(WorkIndex);
			end else begin
				inc(WorkIndex); {do before searching children}
				if N^.Expanded and (N^.Child<>nil) then Find(N^.Child);
				N := N^.Next;
			end;
		end;{}
	end;

begin
	WorkIndex := 0;
	NodeAt := nil;
	Find(RootNode);
end;


{==== Admin function ======}
function GetRootNode(Node : PNode) : PNode;
begin
	while Node^.Parent<>nil do Node := Node^.Parent;
	GetRootNode := Node;
end;

{**********************************************************************
 ***                                                                ***
 ***                   VIEW OF NODE TREE                            ***
 ***                                                                ***
 **********************************************************************}

{=== INITIALISE ==========================================}
constructor TNodeView.Init;
begin
	{--Set up view --}
	inherited Init(Bounds, NlsType);

	New(Tree, init);
	ChainOnly := False;

{	ClipBoard^.Clear; {jic anything there already}
end;

{=== DONE ================}
destructor TNodeView.Done;
begin
	dispose(Tree, done);
{	ClipBoard^.Clear;{}
	inherited Done;
end;


procedure TNodeView.DoStartUp;
begin
	DoneStartUp := True;
	LoadTree; {and redraw}
end;


procedure TNodeView.FocusNode;
begin
	FocusItem(Tree^.IndexAt(Node));
end;


{*************************************
 ***       HANDLE EVENT            ***
 *************************************}
procedure TNodeView.HandleEvent(var Event : TEvent);
begin
	if (Event.What = evKeyDown) and GetState(sfFocused) then begin

		case Event.KeyCode of
			kbLeft : if DrawnFocused then begin
				{go to parent, if there is one}
				with Tree^.NodeAt(Focused)^ do if Parent<> nil then FocusNode(Parent);
				DrawView;
				ClearEvent(Event);
			end;
			kbRight : if DrawnFocused then begin
				with Tree^.NodeAt(Focused)^ do begin
					if Child<>nil then begin
						{expand if nec}
						if not Expanded then Expanded := True;
						FocusNode(Child);
						DrawView;
					end;
				end;
			end;
		end;

		if {Focused<>-1{} Tree^.NodeAt(Focused)<>nil then begin
			case Event.CharCode of

				'+' : begin Tree^.NOdeAt(Focused)^.Expanded := True; DrawView; ClearEvent(Event); end;
				'-' : begin Tree^.NodeAt(Focused)^.Expanded := False; DrawView; ClearEvent(Event); end;
			end;
		end;
	end;

	inherited HandleEvent(Event);
end;

{************************************
 ***        GET TEXT              ***
 ************************************}
{Works out line drawing required in front of first line of Node}
function TNodeView.TreeLines(Node : PNode) : string;
var S : string;
begin
	{1st char is À (192) if no more peers, or Ã (195) if more}
	if Node^.Next = nil then S := #192 else S := #195;

	{After this, work up each level, if node at that level has more peers,
	put in a pipe ³ #179 or space o/wise}
	while Node^.Parent<> nil do begin
		Node := Node^.Parent;
		if Node^.Next = nil then S := ' '+S else S := #179+S;
	end;

	TreeLines := Copy(S,2,length(S));  {ignore first char, assume all first level act as an ordinary list}
end;

{Works out line drawing required in front of all lines of text from gettext,
ie does above for first line, then below for supplementary lines, eg:
				³	³
				³	ÀHI THERE
				³	 Everyone <- supplementary line

{Suppl same as ordinary tree lines but first char is bar if peers, space if not}

function TNodeView.AddTreeLines(Node : PNode; S : string) : string;
var TL,STL, S2 : string;
begin
	{used by descendants to add tree lines & suppl tree lines to a displayline
	string S}
	TL := TreeLines(Node); {Main tree line - for first line}

	{for supplementary lines, we just change the last char}
	STL := TL;
	if length(STL)>0 then if STL[length(STL)] = #192 {À} then STL[length(STL)] := ' ' else STL[length(STL)] := #179 {³};

	S := TL+S;

	S2 := '';
	while pos(#13,S)>0 do begin
		S2 := S2 + Copy(S,1,pos(#13,S)) + STL;
		S := Copy(S,pos(#13,S)+1,256);
		if S[1] = #10 then S := Copy(S, 2, 256); {chop out LF in case of CRLF rather than just CR}
		if (S[1]=' ') and (Node^.Child<>nil) then S[1] := #179; {³ if peer and space to put it}
	end;
	AddTreeLines := S2 + S;  {final line}
end;

{Needs to add funny lines to LHS}
function TNodeView.GetText;
var	Node : PNode;

begin
	{$IFDEF fixit}
	Node := Tree^.NodeAt(ItemNo);

	if Node <> nil then with Node^ do begin

		GetText := #13+'  TEK:' + N2Str(ItemNo)
							+ ' ID' + N2Str(RecNo)
							+ ' K' + N2Str(GetKey)
							+ ' Nx'  + N2Str(NextID)
							+ ' Pv'  + N2Str(PrevID)
							+ ' Ch'	 + N2Str(ChildID);

	end;
	{$ENDIF}
end;{}

procedure TNodeView.LoadTree;
begin
	Tree^.RootNodeID := GetOwnersRoot;
	Tree^.LoadTree;
	SetRange;
	Redraw;
end;


procedure TNodeView.SetRange;
begin
	FirstItem := 0;
	{doing a Tree^.NumNodes -1 gives a 215 if numnodes is 0, as numnodes is a
		word and so the calculation is a word, methinks...}
	LastItem := Tree^.NumNodes -1;
	inherited SetRange; {updates scroll bar}
end;



{Used by edit new, edit if key changes (and after deleting old one) and in pasting}
{procedure TNodeView.InsertNewNode(ParentNode, Node : PNode);
var RecNo : longint;
begin
	if (ParentNode <> nil) and (ParentNode^.Heap.Parent<>nil) then begin
		AddChild2Node(ParentNode, Node); {see tree maintenance methods above}
{		RecNo := ParentNode^.RecNo; {focus point on parent}
{	end else begin
		{Nothing focused (new) or root focused}
{		AddChild2Node(ParentNode, Node); {see tree maintenance methods above}
{		RecNo := -1;  {will move to beginning - ie root}
{	end;

	SetNodeIndex; {re-index with new tree}

	{sort out list}
{	FocusNode(Node^.Heap.Parent);  {focus on parent}
{	Redraw;

	SetChanged;
end;




{***********************************************
 ***         DELETE ITEM                    ***
 ***********************************************}
procedure TNodeView.Del(ItemNo : longint);
var	ParentNode, Node : PNode;
		ParentRec : longint;

begin
	{ItemNo is position in Nodeindex}
	if not InRange(ItemNo) then exit; {root node}

	Node := Tree^.NodeAt(ItemNo);

	if ItemNo = Focused then GetPrevItemNo(FOcused);

	Tree^.DetachNode(Node); {remove node from tree}{
	ClipBoard^.PasteOn(Node); {Paste onto clipboard for pasting}
	if Tree^.RootNode=nil then
		Tree^.RootNodeID := -1
	else
		Tree^.RootNodeID := Tree^.RootNode^.RecNo;
	SetOwnersRoot; {update owner's pointer}

{	FocusItem(Node^.RecNo);                              {Focus on deleted one's parent}
	LoadTree; {and redraw}
{	ReDraw;                                       {Re draw screen}
	SetChanged;                              {Mark list as having changed}

	FindOKItemNo(Focused);

	EnableCommands([cmPasteNode]);
end;




{******************************************
 ***       CREATE NEW ITEM OF SRTYPE    ***
 ******************************************}
procedure TNodeView.SetOwnersRoot;
begin end;

function TNodeView.GetOwnersRoot : longint;
begin end;


{**********************************************************************
 ***                                                                ***
 ***                   CHAIN STREAM                                 ***
 ***                                                                ***
 **********************************************************************}

{==== PEER GETTING/PUTTING =============}
function TChainStream.GetNext;
var Node : PNode;
begin
	Node := nil;
	if (RecNo > -1) and (RecNo<NoRecs) then begin
		Node := PNode(GetAt(RecNo));

		{Check to see if loaded OK}
		if Node = nil then
			DBaseMessage(@Self,'CHAIN FILE'#13#10'Could not load rec#'+N2Str(RecNo), mfError, hcInternalErrorMsg)
		else
			{Check to see if item points to self --> continuous looping}
			if Node^.NextID = RecNo then begin
				DBaseMessage(@Self,'Chain Item points to self #'+N2Str(RecNo)+#13#10'Truncating chain', mfError, hcInternalErrorMsg);
				Node^.NExtID := -1;
				PutAt(RecNo, Node); {fixit}
				RecNo := -1; {mark as end of chain}
			end else begin
				{All OK - set recno for next record}
				RecNo := Node^.NextID;
				if Status<>stOK then ErrorMsg('Loading Chain Item');
			end;
	end;

	if Node = nil then RecNo := -1;  {Something went wrong or recno=-1}
	GetNext := Node;
end;

{---- STORE ITEM AND RETURN REC NO OF NEXT ONE -------}
{Stores item over top of previous one - if there - o/w adds to end}
{Routines for where the chain is retreived/stored as a one-off collection,
		 like the letter data. Requires storage of just Next field}
{Send RecNo as position to store, P as untyped Pointer to ChainItem descendant,
		 and More as boolean check for are there any more to come after}
{Returns RecNo as position of next one to store}

procedure TChainStream.PutNext;
var WorkNode : PNode;
begin
	if Node=nil then begin
		DBaseMessage(@Self,'Putting a nil node? RecNo='+N2Str(RecNo),mfError, hcInternalErrorMsg);
		exit;
	end;

	if not More then
		Node^.NextID := -1 {no more to follow, so mark end of chain}
	else
		{more, so see if we can follow the existing chain}
		if (RecNo>-1) and (RecNo<NoRecs) then begin
			{Check previously stored record}
			WorkNode := PNode(GetAt(RecNo));
			Node^.NextID := WOrkNode^.NextID; {set next ID to follow the chain on disk}
			Dispose(WorkNode, done);
			if Node^.NextID = -1 then Node^.NextID := NoRecs;  {Extend old chain}
		end else begin
			{Add to end}
			RecNo := NoRecs;
			Node^.NextID := NoRecs+1;   {Will be added on after this one}
		end;

	{Store over top}
	PutAt(RecNo, Node);
	if Status<>stOK then ErrorMsg('Storing Chain Item');

	{Set recno to next position}
	RecNo := Node^.NextID;
end;




{********************************************
 ***          INSERT                      ***
 ********************************************}
{Routines for where the items are loaded and stored individually, rather
 than as block chains as above, eg hooking on jimmys}
{FirstinChain is pointer to first item in Chain}
procedure TChainStream.Insert(var FirstNodeID : longint; const NewNode : PNode; const Bias : boolean);
var Work, Work2 : PNode;
		NextID, PrevID : longint;        {Next and prev positions in Chain}
begin
{	LatestInserted := True;{}
	{$IFNDEF SingleUser} Flush; {$ENDIF} {clear buffers so we are reading from latest disk info}

	{Find position in Chain to insert}
	NextID := FirstNodeID;      {Start at beginning}
	PrevID := -1;
	if (NextID<>-1) then begin
		Work := PNode(GetAt(NextID));   {Load old first one}

		{========= SAFETY CHECKS =================}
		if Work = nil then begin
			DBaseMessage(@Self, 'Cannot load Node Rec#'+N2Str(NextID)+#13
													+'TCHainStream.Insert('+N2Str(FirstNodeID)+',..)', mfError, hcInternalErrorMsg);
			Reset;
			exit;  {Don't insert}
		end;

		{there should be no previd at this stage - if there is, try to fix}
		if Work^.PrevID<>-1 then begin
			{OK so it's wrong - lets see if previous one is a valid kind of entry.
			{If not, set prev	to -1, if it is, reset the firstinchain pointer}
			if Work^.PrevID = NextID then begin
				{Circular pointer - clear}
				Work^.PrevID := -1;
				PutAt(NextID, Work);
			end else begin
				Work2 := PNode(GetAt(Work^.PrevID));
				if (Work2 = nil) or (Work2^.NextID <> FirstNodeID) then begin
					{Previous one not valid so disconnect from chain}
					DBaseMessage(@Self,'Chain Continues Before'#13#10'Prev='+N2Str(Work^.PrevID)+' (invalid - removing)',
																mfError, hcInternalErrorMsg);
					Work^.PrevID := -1;  {so if it gets inserted at the beginning, corrects chain}
					PutAt(NextID, Work); {store}
				end else begin
					{Previous one appears to be valid, so alter FirstinChain pointer}
					DBaseMessage(@Self,'Chain Continues Before'#13#10'Prev='+N2Str(Work^.PrevID)+' resetting FirstNode',
																mfError, hcInternalErrorMsg);
					FirstNodeID := Work^.PrevID;
					NextID := FirstNodeID;
					dispose(Work, done); Work := Work2; Work2 := nil; {make current the previous one}
				end;

				if Work2<>nil then dispose(Work2, done);
			end;
		end;

		{If a sorting type of record, run through to find sorted insert point, o/w just insert at start}
		if (NewNode^.GetKey<>0) then begin   {If indeed there are any to sort through - sortkey 0 = don't sort}

			{==== SORT ====}
			while (NextID<>-1) and ((Work^.GetKey<NewNode^.GetKey) or ((Work^.GetKey=NewNode^.GetKey) and (Bias=biEnd))) do begin
{				if Work^.GetsrType=Item^.GetsrType then LatestInserted := False; {passing a like-srtype chain item}
				PrevID := NextID;
				NextID := Work^.NextID;
				Dispose(Work, done); Work := nil;
				if NextID<>-1 then Work := PNode(GetAt(NextID));
			end;
		end;

	end;

	{so at this stage, nextID is set to the one before NewNode should be inserted,
	and PrevID to it's previous one}

	NewNode^.NextID := NextID;               {Set pointers}
	NewNode^.PrevID := PrevID;
	NewNode^.RecNo := NoRecs;												{store at end of file, reserving space}
	PutAt(NewNode^.RecNo, NewNode);

	{If not end of Chain, modify next's back pointer}
	if NextID<>-1 then begin
		{Already loaded}
		Work^.PrevID := NewNode^.RecNo;         {Set to where new Node is stored}
		PutAt(NextID, Work);  			     {Store}
		Dispose(work, done);            {Remove from heap}
	 end;

	{if not start of Chain, modify prev forward pointer}
	if PrevID<>-1 then begin
		Work := PNode(GetAt(PrevID));  		{Load onto heap}
		Work^.NextID := NewNode^.RecNo;                  {Modify pointer}
		PutAt(PrevID, Work);  		              {Store}
		Dispose(work, done);                     {Remove from heap}
	end else
		{o/w it is start of Chain}
		FirstNodeID := NewNode^.RecNo;                  {And modify initial pointer}

	if Status<>stOK then ErrorMsg('Inserting Chain Item');
	{$IFNDEF SingleUser}Flush; {$ENDIF} {clear buffers so we are reading from latest disk info}
end;

{********************************************
 ***          DELETE                      ***
 ********************************************}
{Removes from Chain}
procedure TChainStream.DeleteLink(var FirstNodeID : longint; RecNo : longint);
var DelNode, WorkNode : PNode;

begin
	MultiUserFlush; {clear buffers so we are reading from latest disk info}

	{Get details of one to be removed}
	DelNode := PNode(GetAt(RecNo));       {Load details into WorkItem object}
	if DelNode=nil then begin
		DBaseMessage(@Self,'Failed to load Chain Item to Delete'#13#10'Rec '+N2Str(RecNo), mfError, hcInternalErrorMsg);
		exit;
	end;

	if FirstNodeID = RecNo then FirstNodeID := DelNode^.NextID;  {Set first ptr to NextItem one}

	{Reset Next's PrevID}
	if DelNode^.NextID <> -1 then begin {Check not last in Chain}
		WorkNode := PNode(GetAt(DelNode^.NextID));     {Create & point to object}
		if WorkNode = nil then begin
			DBaseMessage(@Self,'Failed to load Next Chain Item'#13#10'Rec '+N2Str(DelNode^.NextID), mfError, hcInternalErrorMsg);
			exit;
		end;
		WorkNode^.PrevID := DelNode^.PrevID;    {Make PrevItem pointer point to one PrevItemious to WorkItem}
		PutAt(DelNode^.NextID, WorkNode);                   {Store away}
		Dispose(WorkNode, Done);         {Dispose of object}
	end;

	{Reset PrevItemious item}
	if DelNode^.PrevID <> -1 then begin   {First in Chain}
		WorkNode := PNode(GetAt(DelNode^.PrevID));     {Create & point to object}
		if WorkNode = nil then begin
			DBaseMessage(@Self,'Failed to load Prev Chain Item'#13#10'Rec '+N2Str(DelNode^.PrevID), mfError, hcInternalErrorMsg);
			exit;
		end;
		WOrkNode^.NextID := DelNode^.NextID;    {Point to item after WorkItem one}
		PutAt(DelNode^.PrevID, WorkNode);     {Store away}
		Dispose(WorkNode, Done);         {Dispose of object}
	end;

	{could set all pointers to -1 & store at this stage to mark as cleared...}

	Dispose(DelNode, Done);           {Remove from heap}
	if Status<>stOk then ErrorMsg('Deleting Rec '+N2Str(RecNo));

	MultiUserFlush; {clear buffers so we are reading from latest disk info}
end;

{*********************************
 ***   FIRST THAT, FOR EACH    ***
 *********************************}

procedure TChainStream.ForEach;
var NodeId : longint;
		Node : PNode;
begin
	NodeID := RootNodeID;

	while NodeID<>-1 do begin
		Node := PNode(GetAt(NodeID));

		asm
			LES		DI, Node
			PUSH	ES
			PUSH  DI
			PUSH  WORD PTR [BP]
			CALL 	ActionProc
		end;

		NodeID := Node^.NextID;
		dispose(NOde, done);
	end;
end;


function TChainStream.FirstThat;
var NodeID : longint;
		Found : boolean;
		Node : PNode;

begin
	FirstThat := nil;
	NodeID := RootNodeID;
	Found := False;

	while (not Found) and (NodeID<>-1) do begin
		Node := PNode(GetAt(NOdeID));

		asm
			LES     DI,Node       	{put node parameter onto stack}
			PUSH    ES
			PUSH    DI

			PUSH		WORD PTR [BP]		{put testfunc's parent's stack frame onto stack}

			CALL    TestFunc       	{call testFunc}
			MOV			Found,AL				{load answer from AL}
		end;

		if FOund then
			FirstThat := Node
		else begin
			NodeID := Node^.NExtID;
			dispose(Node, done);
		end;
	end;
end;{}

{**********************************************************************
 ***                                                                ***
 ***                   NODE ITEM STREAM                             ***
 ***                                                                ***
 **********************************************************************}

{*********************************
 ***   FIRST THAT, FOR EACH    ***
 *********************************}

procedure TNodeStream.ForEach;
var StackFrame : word;

	{recursive part}
	procedure DoNode(NodeID : longint);
	var Node : PNode;
			W : word;
			P : pointer;

	begin
		while (NodeID<>-1) do begin
			Node := PNode(GetAt(NodeID));

			{See comments above - tree processing}
			{Convert parent's stuff to local}
			W := StackFrame;
			P := ActionProc;

			{call testfunc with testfunc's parent's stack}
			asm
				LES     DI,Node       {put node parameter onto stack}
				PUSH    ES
				PUSH    DI
				PUSH		W							{put testfunc's parent's stack frame onto stack}
				CALL    P            	{call testFunc}
			end;

			if (Node^.Expanded) and (Node^.ChildID<>-1) then DoNode(Node^.ChildID); {do children}
			NodeID := Node^.NextID;
			dispose(Node, done);
		end;
	end;


begin
	{store caller's stack frame so it's local proc can use it}
	asm
		PUSH WORD PTR [BP]
		POP StackFrame
	end;{}

	DoNode(RootNodeID); {start at root}
end;


function TNodeStream.FirstThat;
var StackFrame : word;

	{recursive part}
	function DoNode(NodeID : longint) : PNode;
	var FoundNode : PNode;
			FOund : boolean;
			Node : PNode;
			W : word;
			P : pointer;

	begin
		FoundNode := nil;
		while (FoundNode=nil) and (NodeID<>-1) do begin
			Node := PNode(GetAt(NodeID));

			{See comments above}
			{Convert parent's stuff to local}
			W := StackFrame;
			P := TestFunc;

			{call testfunc with testfunc's parent's stack}
			asm
				LES     DI,Node       {put node parameter onto stack}
				PUSH    ES
				PUSH    DI

				PUSH		W							{put testfunc's parent's stack frame onto stack}

				CALL    P            	{call testFunc}
				MOV			Found,AL			{load answer from AL}
			end;

			if Found then
				FoundNode := Node
			else begin
				if (Node^.Expanded) and (Node^.ChildID<>-1) then begin
					LastParentID := NodeID;
					FoundNode := DoNode(Node^.ChildID); {do children}
				end;
				NodeID := Node^.NextID;
				dispose(Node, done);
			end;
		end;

		DoNode := FoundNode;
	end;


begin
	{store caller's stack frame so it's local proc can use it}
	asm
		PUSH WORD PTR [BP]
		POP StackFrame
	end;{}

	LastParentID := -1;
	FirstThat := DoNode(RootNodeID); {start at root}
end;{}

{function TNodeStream.FirstThat;
{var FoundNode : PNode;
{		FOund : boolean;
{		Node : PNode;
{
{	begin
{		FoundNode := nil;
{		while (FoundNode=nil) and (NodeID<>-1) do begin
{			Node := PNode(GetAt(NodeID));
{
{			{see above for problem doing a if TFirstThatFunc(Test)(Node) then{}
{{			Found := TFirstThatFunc(Test)(Node);{}
{
{{			Found := False;{}
{			asm
{				{put the node parameter on the stack}
{				LES     DI,Node
{				PUSH    ES
{				PUSH    DI
{[
{				{put the stack frame of the test proc's "parent proc" onto the stack}
{[				{check objects.pas collection.foreach for windows variation}
{				PUSH    WORD PTR [BP]		{see p295 lang guide, stack frame}

{				CALL    Test            {call test given}
{				MOV			Found,AL				{load answer - from AL?}
{			end;{}
{
{			if Found then
				FoundNode := Node
			else begin
				if (Node^.Expanded) and (Node^.ChildID<>-1) then FoundNode := FirstThat(Node^.ChildID, Test); {do children}
{				NodeID := Node^.NextID;
				dispose(Node, done);
			end;
		end;

		FirstThat := FoundNode;
	end;


{*********************************
 ***      INSERT PEER          ***
 *********************************}

{procedure TNodeStream.InsertPeer(var RootID : longint; ParentID, PeerID : longint; var NewPeer : PNode);
var WorkNode : PNode;
		RecNo : longint;

begin
	if (NewPeer=nil) then exit;

	{safety}
{	NewPeer^.Disk.Prev := -1;
	NewPeer^.Disk.Next := -1;
	{NewPeer^.Disk.FirstChild := -1; don't reset this - might be re-inserting existing item}

{	if PeerID = -1 then begin
		{New child of a parent}
{    RecNo := NoRecs;
		NewPeer^.recNo := RecNo;
		PutAt(RecNo, NewPeer);
		SetParentPtr(RootID, ParentID, RecNo);
	end else begin
		{Peers exist, so sort through}

{		RecNo := PeerID; {in case while loop is not used}
{		WorkNode := PNode(GetAt(RecNo));

		while (WorkNode^.GetKey<=NewPeer^.GetKey) and (WorkNode^.Disk.Next <> -1) do begin
			RecNo := WorkNode^.Disk.Next;
			dispose(WorkNode, done);
			WorkNode := PNode(GetAt(RecNo));
		end;

		if (RecNo=PeerID) and (WorkNode^.GetKey>NewPeer^.GetKey) then begin
			{add to start of "chain"}
{			NewPeer^.Disk.Next := RecNo;		{set to work node}
{			NewPeer^.RecNo := NoRecs;
{			PutAt(NoRecs, NewPeer); {store new peer}
{			WorkNode^.Disk.Prev := NewPeer^.RecNo;  {set to where newpeer will be stored}
{			PutAt(RecNo, WorkNode);         {store work node}
{			SetParentPtr(RootID, ParentID, NewPeer^.RecNo);  {Set parent->child pointer}
{		end else
{			if (WorkNode^.Disk.Next = -1) and (WorkNode^.GetKey<=NewPeer^.GetKey) then begin
{				{add to end of chain}
{				NewPeer^.Disk.Prev := RecNo;
{				NewPeer^.RecNo := NoRecs;
{				PutAt(NoRecs, NewPeer);  {reserve space as quickly as poss}
{				WorkNode^.Disk.Next := NewPeer^.RecNo;
{				PutAt(RecNo, WorkNode);
{			end else begin
{				{add to middle of chain - before worknode}
{				NewPeer^.Disk.Prev := WorkNode^.Disk.Prev;
				NewPeer^.Disk.Next := RecNo;
				NewPeer^.RecNo := NoRecs;
				PutAt(NoRecs, NewPeer); {store as quickly as poss at end of file to reserve space on m/user systems}

				{set next item's pointers}
{        WorkNode^.Disk.Prev := NewPeer^.RecNo;
				PutAt(RecNo, WorkNode);
				dispose(WorkNode, done);
				{set prev item's pointers}
{				WorkNode := PNode(GetAt(NewPeer^.Disk.Prev));
				WorkNode^.Disk.Next := NewPeer^.RecNo;
				PutAt(NewPeer^.Disk.Prev, WorkNode);
			end;

		dispose(WorkNode, done);
	end;
end;

{*********************************
 ***      INSERT CHILD         ***
 *********************************}
{procedure TNodeStream.InsertChild(var RootID : longint; ParentID : longint; var NewChild : PNode);
var	ParentNode : PNode;

begin
	{safety measures}
{	if (NewChild = nil) then begin
		ProgramError('NewChild=nil','InsertChild, NodeStream');
		exit; {shouldn't be called...}
{  end;

	if ParentID = -1 then begin
		{Can't insert a child of a parent if the parent is not given}
{		ProgramError('ParentID=-1','InsertChild, NodeStream');
		exit;
	end;

	ParentNode := PNode(GetAt(ParentID));

	if ParentNode = nil then
		DBaseError(@Self,'Could not retrieve Node','InsertChild, ParentID='+L2Str(ParentID));
	InsertPeer(RootID, ParentID,ParentNode^.Disk.FirstChild, NewChild);

	dispose(ParentNode, done);
end;


{sets parent pointer to NewID - might be root}
{procedure TNodeStream.SetParentPtr(var RootID : longint; ParentID,NewID : longint);
var ParentNode : PNode;
begin
	if ParentID = -1 then
			{No parent - therefore root}
{			RootID := NewID
	else begin
		 {parent defined - retreive, change & store}
{			ParentNode := PNode(GetAt(parentID));
			ParentNode^.ChildID := NewID;
			PutAt(ParentID, ParentNode);
			dispose(ParentNode, done);
	end;
end;


{*********************************
 ***      DELETE NODE          ***
 *********************************}
{procedure TNodeStream.Delete;
var DelNode, WorkNode : PNode;
		RecNo : longint;

begin
	DelNode := PNode(GetAt(NodeID));

	{Remove backpointer of Next item}
{	RecNo := DelNode^.NextID;
	if RecNo>-1 then begin
		WorkNode := PNode(GetAt(RecNo));
		WorkNode^.PrevID := DelNode^.PrevID;
		PutAt(RecNo, WorkNode);
		dispose(WorkNode, done);
	end;

	{Remove forward pointer of Prev Item}
{	RecNo := DelNode^.PrevID;
	if RecNo>-1 then begin
		WorkNode := PNode(GetAt(RecNo));
		WorkNode^.NextID := DelNode^.NextID;
		PutAt(RecNo, WorkNode);
		dispose(WorkNode, done);
	end else
		SetParentPtr(RootID, ParentID, DelNode^.NextID); {Move parent's pointer to recno}

{	DelNode^.PrevID := -1;
	DelNode^.NextID := -1;
{	DelNode^.Disk.Parent := -1;{}
{	PutAt(NodeID, DelNode);
	dispose(DelNode, done);
end;{}


begin
{	NodeCutPasteIndex := -1;                           {}
end.
