⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 galnklist.pas

📁 一个sql语法分析程序
💻 PAS
📖 第 1 页 / 共 4 页
字号:
begin
  inherited InitDoubleList;
  { set the cursor to the head node and item count to the zero}
  FCursor := FHead;
  FCount := 0;
  FNodeRevID := 0;
end;

procedure TgaDoubleList.InsertAfterCurrent(AItem: Pointer; MoveCursorToNewItem: 
        boolean);
{:
procedure InsertAfterCurrent - Inserts a item represented by the AItem after the
cursor. If MoveCursorToNewItem = True, then the cursor is moved to the item
inserted.
}
begin
  if MoveCursorToNewItem then
    FCursor := InternalInsert(AItem, Cursor)
  else
    InternalInsert(AItem, Cursor);
end;

function TgaDoubleList.IsCursorCorrect: Boolean;
{:
function IsCursorCorrect - Returns a boolean indicating whether the node
pointed by the cursor is inside the list or .
}
begin
  Result := IsNodeInside(FCursor);
end;

procedure TgaDoubleList.Last;
{:
procedure Last - sets the cursor to point to the last item in the list.
If the list is empty, the item will be the Head item. After the call to the
last method, the EOF is always False (but Bof might be true, in the case of
empty list).
}
begin
  FCursor := Tail^.dllnPrev;
end;

function TgaDoubleList.Locate(AItem: Pointer): Boolean;
{:
function Locate -  postions cursor to the first node that contains AItem, if
one exists. If the node is found, it returns True. If not, it returns False.
}
var
  tmpCursor: PdllNode;
begin
  tmpCursor := NodeOf(AItem);
  if Assigned(tmpCursor) then
  begin
    FCursor := tmpCursor;
    Result := True;
  end else
    Result := False;
end;

procedure TgaDoubleList.Next;
{:
procedure Next moves the cursor to the next item on the list. If cursor is
already at the end of the list, it deos nothing.
}
begin
  if not Eof then
    FCursor := Cursor^.dllnNext;
end;

procedure TgaDoubleList.NotifyNodeChange(ANode: PdllNode; Action: 
        TgaNodeNotification);
{:
procedure NotifyNodeChange overrides inherited NotifyNodeChange calls inherited
NotifyNodeChange.
In addition, it corrects the item count of the list, changes cursor if required,
increments Node Revision ID and notifies Active mirroring lists about the
change.
}
var
  tmpCursor: PdllNode;
  tmpTail: PdllNode;
begin
  inherited NotifyNodeChange(ANode, Action);
  { correct the list item count }
  case Action of
    nnAdded:
      Inc(FCount);
    nnDeleted:
      Dec(FCount);
    nnCleared:
      FCount := 0;
  end;
  if Action in [nnAdded, nnDeleted] then
  begin
    { if the Node, which is about to destroy, is current cursor then move cursor
      to the next item }
    if Assigned(FCursor) and (ANode = FCursor) then
      FCursor := ANode^.dllnNext;
    { increment the Node Rev ID }
    Inc(FNodeRevID);
    { Notify active mirror lists about the change... }
    if Assigned(FActiveDataUserList) then
    begin
      tmpCursor := FActiveDataUserList.Head^.dllnNext;
      tmpTail := FActiveDataUserList.Tail;
      while tmpCursor <> tmpTail do
      begin
        TgaSharedDoubleList(tmpCursor^.dllnData).NotifyMasterChanged(ANode, Action);
        tmpCursor := tmpCursor^.dllnNext;
      end;
    end;
  end else begin
    { Reset Cursor }
    FCursor := FHead;
    { Clear Node Rev ID }
    FNodeRevID := 0;
    { Notify mirror lists about the clear }
    if Assigned(FDataUserList) then
    begin
      tmpCursor := FDataUserList.Head^.dllnNext;
      tmpTail := FDataUserList.Tail;
      while tmpCursor <> tmpTail do
      begin
        TgaSharedDoubleList(tmpCursor^.dllnData).NotifyMasterChanged(ANode, Action);
        tmpCursor := tmpCursor^.dllnNext;
      end;
    end;
  end;
end;

procedure TgaDoubleList.Pack;
{:
procedure Pack - removes nil items from the list.
}
var
  tmpCursor: PdllNode;
begin
  tmpCursor := Head^.dllnNext;
  while tmpCursor <> FTail do
  begin
    if tmpCursor^.dllnData = nil then
    begin
      tmpCursor := tmpCursor^.dllnNext;
      InternalDelete(tmpCursor^.dllnPrev);
    end else
      tmpCursor := tmpCursor^.dllnNext;
  end;
end;

procedure TgaDoubleList.Previous;
{:
procedure Previous moves the cursor to the previous item in the list.
If cursor is already at the beginning of the list, it deos nothing.
}
begin
  if not Bof then
    FCursor := FCursor^.dllnPrev;
end;

procedure TgaDoubleList.Remove(Item: Pointer);
{:
procedure Remove - removes the first copy of the Item from the list.
}
var
  tmpNode: PdllNode;
begin
  tmpNode := NodeOf(Item);
  if Assigned(tmpNode) then
    InternalDelete(tmpNode);
end;

procedure TgaDoubleList.RemoveActiveDataUser(ADataUser: TgaSharedDoubleList);
{:
procedure RemoveActiveDataUser -  removes ADataUser from the NodeChangeNotify
list. This is called whet the ActiveDataShare := False in the mirror list.
If ADataUser is not foun from the list, this method deos nothing.
}
var
  tmpNode: PdllNode;
begin
  if Assigned(FActiveDataUserList) then
  begin
    tmpNode := FActiveDataUserList.NodeOf(ADataUser);
    if Assigned(tmpNode) then
      FActiveDataUserList.InternalDelete(tmpNode);
  end;
end;

procedure TgaDoubleList.RemoveDataUser(ADataUser: TgaSharedDoubleList);
{:
procedure RemoveDataUser - removes ADataUser from destroy notify list.
Normally called when the mirror list is destroyed.
if ADataUser is not found in list, the method does nothing.
}
var
  tmpNode: PdllNode;
begin
  if Assigned(FDataUserList) then
  begin
    tmpNode := FDataUserList.NodeOf(ADataUser);
    if Assigned(tmpNode) then
      FDataUserList.InternalDelete(tmpNode);
  end;
end;

procedure TgaDoubleList.SetCurrentItem(Value: Pointer);
{:
SetCurrentItem is the write access method of the CurrentItem property.
}
var
  tmpItem: Pointer;
begin
  if Eof or Bof then
    raise EgaLinkListError.Create(SNoCurrentItemForTheOperation);
  tmpItem := Cursor.dllnData;
  if tmpItem <> Value then
  begin
    Cursor.dllnData := Value;
    NotifyChange(tmpItem, Value);
  end;
end;

procedure TgaDoubleList.SetFirstItem(Value: Pointer);
{:
SetFirstItem is the write access method of the FirstItem property.
It sets the first item (the one after the Head node) in the list.
If the list is empty, the exeception is raised.
}
var
  tmpItem: Pointer;
begin
  if IsEmpty then
    raise EgaLinkListError.Create(SNoItemsInTheList);
  tmpItem := Head^.dllnNext.dllnData;
  if tmpItem <> Value then
  begin
    Head^.dllnNext.dllnData := Value;
    NotifyChange(tmpItem, Value);
  end;
end;

procedure TgaDoubleList.SetLastItem(Value: Pointer);
{:
SetLastItem is the write access method of the LastItem property.
It sets the last item (the one before the Tail node) in the list.
If the list is empty, the exeception is raised.
}
var
  tmpItem: Pointer;
begin
  if IsEmpty then
    raise EgaLinkListError.Create(SNoItemsInTheList);
  tmpItem := Tail^.dllnPrev.dllnData;
  if tmpItem <> Value then
  begin
    Tail^.dllnPrev.dllnData := Value;
    NotifyChange(tmpItem, Value);
  end;
end;

{
***************************** TgaSharedDoubleList ******************************
}
constructor TgaSharedDoubleList.Create;
{:
Constructor Create overrides the inherited Create.
First the internal data structure is initialized to indicate that the list
itself is the owner of the data, then inherited Create is
called.
}
begin
  FDataOwner := Self;
  FIsDataOwner := True;
  inherited Create;
end;

constructor TgaSharedDoubleList.CreateMirror(AMirroredList: TgaDoubleList);
{:
constructor CreateMirror - creates a "mirror" list for the AMirroredList. The
lists will have common dataowner (i.e. if Ythe AMirroredList is itself a mirror,
then the dataowner will be the dataowner of the AMirroredList). Note that the
DataIwner of TgaDoubleList is implicitly the list itself.
The contents of the list will be exactly the same as it is for AMirroredList -
if it has strict last or first item, a new mirror will have the same.
the starting/ening postions can be changed later trough the call to
SetStartPos/SetEndPos.
}
var
  tmpActiveMirror: TgaSharedDoubleList;
begin
  FHead := AMirroredList.Head;
  FTail := AMirroredList.Tail;
  if AMirroredList is TgaSharedDoubleList then
  begin
    tmpActiveMirror := TgaSharedDoubleList(AMirroredList);
    FDataOwner := tmpActiveMirror.DataOwner;
    FFirstNode := tmpActiveMirror.FFirstNode;
    FLastNode := tmpActiveMirror.FLastNode;
  end else
    FDataOwner := AMirroredList;
  DataOwner.AddDataUser(Self);
  DataOwner.AddActiveDataUser(Self);
  FActiveDataShare := True;
  FIsDataOwner := False;
  FNodeRevID := AMirroredList.NodeRevID;
  FCursorNodeRev := DataOwner.NodeRevID;
  inherited Create;
end;

destructor TgaSharedDoubleList.Destroy;
{:
Destructor Destroy overrides the inherited Destroy.
If the list is a mirroring list, then the list must be removed from the
(Active)DataUserList of the DataOwner. Also, the Head and Tail must be cleared
to avoid changing the master list.
Finally inherited Destroy is called.
}
begin
  if not IsDataOwner then
  begin
    if Assigned(FDataOwner) then
    begin
      ActiveDataShare := False;
      FDataOwner.RemoveDataUser(Self);
    end;
    FTail := nil;
    FHead := nil;
    FFirstNode := nil;
    FLastNode := nil;
  end;
  inherited Destroy;
end;

procedure TgaSharedDoubleList.Add(Item: Pointer);
{:
procedure Add overrides inherited Add.
This method is overridden to allow the strict mirror list to grow, if the
Add method is called on this instance. To do that, the FirstNode and LastNode
are unbound, then inherited Add is called. After that, theese nodes are rebound,
if needed.
}
var
  WasStrictLast: Boolean;
  FirstNodeWasUnbound: Boolean;
begin
  WasStrictLast := Assigned(FLastNode);
  FLastNode := nil;
  // Unbind the first node, if list is strictempty
  FirstNodeWasUnbound := FFirstNode = FTail;
  if FirstNodeWasUnbound then
    FFirstNode := nil;
  inherited Add(Item);
  if WasStrictLast then
    FLastNode := Tail^.dllnPrev;
  if FirstNodeWasUnbound then
    FFirstNode := Head^.dllnNext;
end;

procedure TgaSharedDoubleList.AddActiveDataUser(ADataUser: TgaSharedDoubleList);
{:
procedure AddActiveDataUser overrides inherited AddActiveDataUser.
If the list is not a Data Owner, then an exception is raised to indicate that
mirroring lists can't have data users.
}
begin
  if not IsDataOwner then
    raise EgaLinkListError.CreateFmt(SListIsNotDataOwner, [SCantAddActiveDataUser]);
  inherited AddActiveDataUser(ADataUser);
end;

procedure TgaSharedDoubleList.AddDataUser(ADataUser: TgaSharedDoubleList);
{:
procedure AddDataUser overrides inherited AddDataUser calls
If the list is not a Data Owner, then an exception is raised to indicate that
mirroring lists can't have data users.
}
begin
  if not IsDataOwner then
    raise EgaLinkListError.CreateFmt(SListIsNotDataOwner, [SCantAddDataUser]);
  inherited AddDataUser(ADataUser);
end;

procedure TgaSharedDoubleList.CheckListBorders;
{:
procedure CheckListBorders overrides inherited donothing
TgaSimpleDoubleList.CheckListBorders. For optimization, the call to inherited
CheckListBorders is omitted.
ValidateListBorders is called if required - the list is mirroring list and it
is not in the DataOwner's ActiveDataUser list (ActiveDataShare = False)
ValidateListBorders corrects Head and Tail nodes, if needed and possible.
If unrepairable error occures, an exception is raised.
}
begin
  // call to inherited do-nothing method not required??
  if not IsDataOwner then
    if not ActiveDataShare then
      ValidateListBorders;
end;

procedure TgaSharedDoubleList.CheckListCursor;
{:
procedure CheckListCursor overrides inherited donothing
TgaSimpleDoubleList.CheckListCursor. For optimization, the call to inherited
CheckListCursor is omitted.
If cursor is not inside the list, and exception is raised in ValidateCursor
method.
}
begin
  // call to inherited do-nothing method not required??
  if not IsDataOwner then
    if (not ActiveDataShare) then
      ValidateCursor(False);
end;

procedure TgaSharedDoubleList.Clear;
{:
procedure Clear overrides inherited Clear.
The inherited Clear is called only if the list is a owner of the data.
If not, the list is emptied item by item.
}
var
  Temp: PdllNode;
  tmpData: Pointer;
  FFirstNodeWasBound, FLastNodeWasBound: Boolean;
begin
  if IsDataOwner then
    inherited Clear
  else begin
    if Assigned(FHead) then
    begin
      Temp := Head^.dllnNext;
      FFirstNodeWasBound := Assigned(FFirstNode);
      FFirstNode := nil;
      FLastNodeWasBound := Assigned(FLastNode);
      FLastNode := nil;
      while (Temp <> FTail) do begin
        FHead^.dllnNext := Temp^.dllnNext;
        NotifyNodeChange(Temp, nnDeleted);
        tmpData := Temp^.dllnData;
        dnmFreeNode(Temp);
        if Assigned(tmpData) then
          Notify(tmpData, lnDeleted);
        Temp := FHead^.dllnNext;
      end;
      FHead^.dllnNext := FTail;
      FTail^.dllnPrev := FHead;
      { #Todo2 There will be conflict if the list has strict starting position
       but floating end position - should it be kept empty or not }
      if FFirstNodeWasBound  then

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -