mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-05 10:57:55 +02:00
1156 lines
29 KiB
ObjectPascal
1156 lines
29 KiB
ObjectPascal
unit frpeditor;
|
|
{
|
|
***************************************************************************
|
|
* *
|
|
* This source is free software; you can redistribute it and/or modify *
|
|
* it under the terms of the GNU General Public License as published by *
|
|
* the Free Software Foundation; either version 2 of the License, or *
|
|
* (at your option) any later version. *
|
|
* *
|
|
* This code is distributed in the hope that it will be useful, but *
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
|
* General Public License for more details. *
|
|
* *
|
|
* A copy of the GNU General Public License is available on the World *
|
|
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
|
* obtain it by writing to the Free Software Foundation, *
|
|
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Michael Van Canneyt
|
|
Changed to Frame by Vladislav V. Sudarikov
|
|
}
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses SysUtils, Classes, DOM, Forms, Controls, ExtCtrls, ComCtrls,
|
|
StdCtrls, Dialogs, Menus, FPDEUtil, LazDEMsg, LazDEOpts, LazLoggerBase;
|
|
|
|
Type
|
|
{ TPackageEditor }
|
|
|
|
{ TPackEditorFrame }
|
|
|
|
TPackEditorFrame = Class(TFrame)
|
|
GroupBox1: TGroupBox;
|
|
lblNodeStructure: TLabel;
|
|
lblStructure: TLabel;
|
|
MenuItem1: TMenuItem;
|
|
MenuItem2: TMenuItem;
|
|
PEMenu: TPopupMenu;
|
|
pnlElements: TPanel;
|
|
pnlModules: TPanel;
|
|
PMMenu: TPopupMenu;
|
|
Splitter1: TSplitter;
|
|
trvElements: TTreeView;
|
|
trvModules: TTreeView;
|
|
Procedure ModuleChange(Sender: TObject; Node: TTreeNode);
|
|
Procedure ModuleChanging(Sender: TObject; Node: TTreeNode;
|
|
Var AllowChange : Boolean);
|
|
Procedure ElementChange(Sender: TObject; Node: TTreeNode);
|
|
Procedure ElementChanging(Sender: TObject; Node: TTreeNode;
|
|
Var AllowChange : Boolean);
|
|
Private
|
|
FModified : Boolean;
|
|
FDescriptionNode : TDomNode;
|
|
FCurrentPackage,
|
|
FCurrentElement,
|
|
FCurrentModule,
|
|
FCurrentTopic : TDomElement;
|
|
FOnSelectElement,
|
|
FOnSelectPackage,
|
|
FOnSelectTopic,
|
|
FOnSelectModule : TElementEvent;
|
|
FModuleNode : TTreeNode;
|
|
Procedure ShowModuleElements(Module : TDomElement);
|
|
Procedure ClearElements;
|
|
procedure UpdateNodeImage(N: TTreeNode);
|
|
// Element node methods.
|
|
Procedure SelectTopic(Sender : TDomElement);
|
|
Procedure SelectModule(Sender : TDomElement);
|
|
Procedure SelectPackage(Sender : TDomElement);
|
|
Procedure SelectElement(Sender : TDomElement);
|
|
protected
|
|
Procedure SetCurrentModule(Value : TDomElement); virtual;
|
|
Procedure SetCurrentPackage(Value : TDomElement); virtual;
|
|
Procedure SetCurrentElement(E : TDomElement); virtual;
|
|
Procedure SetCurrentTopic(T : TDomElement); virtual;
|
|
Procedure SetDescriptionNode (Value : TDomNode); virtual;
|
|
Public
|
|
Procedure Refresh; virtual; abstract;
|
|
Procedure AddElement(E : TDomElement); virtual; abstract;
|
|
Procedure DeletePackage(P : TDomElement); virtual; abstract;
|
|
Procedure DeleteModule(M : TDomElement); virtual; abstract;
|
|
Procedure DeleteElement(E : TDomElement); virtual; abstract;
|
|
Procedure DeleteTopic(T : TDomElement); virtual; abstract;
|
|
Procedure RenamePackage(P : TDomElement); virtual; abstract;
|
|
Procedure RenameModule(M : TDomElement); virtual; abstract;
|
|
Procedure RenameElement(E : TDomElement); virtual; abstract;
|
|
Procedure RenameTopic(T : TDomElement); virtual; abstract;
|
|
procedure UpdateTree;
|
|
procedure ExpandTree;
|
|
Property DescriptionNode : TDomNode Read FDescriptionNode Write SetDescriptionNode;
|
|
Property OnSelectModule : TElementEvent Read FOnSelectModule Write FOnSelectmodule;
|
|
Property OnSelectTopic : TElementEvent Read FOnSelectTopic Write FOnSelectTopic;
|
|
Property OnSelectPackage : TElementEvent Read FOnSelectPackage Write FOnSelectPackage;
|
|
Property OnSelectElement : TElementEvent Read FOnSelectElement Write FOnSelectElement;
|
|
Property CurrentPackage : TDomElement Read FCurrentPackage Write SetCurrentPackage;
|
|
Property CurrentModule : TDomElement Read FCurrentModule Write SetCurrentModule;
|
|
Property CurrentTopic : TDomElement Read FCurrentTopic Write SetCurrentTopic;
|
|
Property CurrentElement : TDomElement Read FCurrentElement Write SetCurrentElement;
|
|
Property Modified : Boolean Read FModified Write FModified;
|
|
end;
|
|
|
|
TPackageEditor = Class(TPackEditorFrame)
|
|
Private
|
|
FMRenameMenu,
|
|
FMDeleteMenu,
|
|
FERenameMenu,
|
|
FECollapseAllMenu,
|
|
FEExpandAllMenu,
|
|
FEDeleteMenu : TMenuItem;
|
|
// Callbacks for visual controls.
|
|
Procedure MenuRenameClick(Sender : TObject);
|
|
Procedure MenuDeleteClick(Sender : TObject);
|
|
Procedure MenuCollapseAllClick(Sender: TObject);
|
|
procedure MenuExpandAllClick(Sender: TObject);
|
|
// Internal node methods.
|
|
Procedure DeleteNode(Msg : String; N : TTreeNode; E : TDomElement);
|
|
Procedure DeleteElementNode(N : TTreeNode);
|
|
Procedure RenameNode(Msg : String; N : TTreeNode);
|
|
Function GetSelectedNode : TTreeNode;
|
|
Function NewName(ATitle : String;Var AName : String) : Boolean;
|
|
Function AddDomNode(E : TDomElement;Nodes: TTreeNodes;
|
|
AParent : TTreeNode) : TTreeNode;
|
|
Procedure DoTopicNode(Node : TDomElement;Nodes: TTreeNodes;
|
|
AParent : TTreeNode);
|
|
|
|
Procedure SetModuleNode(N : TTreeNode);
|
|
Function CreateElementNode(E : TDomelement) : TTreeNode;
|
|
// Correspondence TreeNode<->TDomElement
|
|
Function FindPackageNode(P : TDomElement) : TTreeNode;
|
|
Function FindModuleNodeInNode(M : TDomElement; N : TTreeNode) : TTreeNode;
|
|
Function FindTopicNodeInNode(M : TDomElement; N : TTreeNode) : TTreeNode;
|
|
Function FindElementNode(E : TDomElement; N : TTreeNode) : TTreeNode;
|
|
|
|
|
|
Procedure SetCurrentElementNode(N : TTreeNode);
|
|
Procedure SetCurrentModuleNode(N : TTreeNode);
|
|
Procedure SetCurrentPackageNode(N : TTreeNode);
|
|
Procedure SetCurrentTopicNode(T : TTreeNode);
|
|
// Other methods
|
|
|
|
function GetElementName(E : TDomElement): String;
|
|
Protected
|
|
Procedure SetCurrentModule(Value : TDomElement); override;
|
|
Procedure SetCurrentPackage(Value : TDomElement); override;
|
|
Procedure SetCurrentElement(E : TDomElement); override;
|
|
Procedure SetCurrentTopic(T : TDomElement); override;
|
|
Procedure SetDescriptionNode (Value : TDomNode); override;
|
|
Public
|
|
Constructor Create(AOwner : TComponent);override;
|
|
Procedure Refresh; override;
|
|
Procedure AddElement(E : TDomElement); override;
|
|
Procedure DeletePackage(P : TDomElement); override;
|
|
Procedure DeleteModule(M : TDomElement); override;
|
|
Procedure DeleteElement(E : TDomElement); override;
|
|
Procedure DeleteTopic(T : TDomElement); override;
|
|
Procedure RenamePackage(P : TDomElement); override;
|
|
Procedure RenameModule(M : TDomElement); override;
|
|
Procedure RenameElement(E : TDomElement); override;
|
|
Procedure RenameTopic(T : TDomElement); override;
|
|
procedure UpdateSelectedNodeStatus;
|
|
|
|
end;
|
|
|
|
var
|
|
PackEditorFrame: TPackEditorFrame;
|
|
implementation
|
|
|
|
uses frmNewNode, graphics, LCLType, strutils;
|
|
|
|
{$R *.lfm}
|
|
{ ---------------------------------------------------------------------
|
|
Auxiliary routines
|
|
---------------------------------------------------------------------}
|
|
|
|
Function GetNextNode(N : TTreeNode) : TTreeNode;
|
|
|
|
begin
|
|
Result:=N.GetNextSibling;
|
|
If (Result=Nil) and (N.Parent<>Nil) then
|
|
begin
|
|
Result:=N.Parent.Items[0]; // Count is always >=0, N !!
|
|
While (Result<>Nil) and (Result.GetNextSibling<>N) do
|
|
Result:=Result.GetNextSibling;
|
|
If (Result=Nil) then
|
|
Result:=N.Parent;
|
|
end;
|
|
end;
|
|
|
|
Function SubNodeWithElement(P : TTreeNode; E : TDomElement) : TTreeNode;
|
|
|
|
Var
|
|
N : TTreeNode;
|
|
|
|
begin
|
|
Result:=Nil;
|
|
If (E<>Nil) and (P<>Nil) and (P.Count>0) then
|
|
begin
|
|
N:=P.Items[0];
|
|
While (Result=Nil) and (N<>Nil) do
|
|
If (N.Data=Pointer(E)) then
|
|
Result:=N
|
|
else
|
|
begin
|
|
//recurse
|
|
if N.HasChildren then
|
|
Result:=SubNodeWithElement(N, E);
|
|
N:=N.GetNextSibling;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ ---------------------------------------------------------------------
|
|
TPackEditorFrame
|
|
---------------------------------------------------------------------}
|
|
|
|
procedure TPackEditorFrame.SetCurrentModule(Value: TDomElement);
|
|
begin
|
|
if (Value <> nil) then begin
|
|
if (Value.ParentNode <> nil) then begin
|
|
CurrentPackage:=Value.ParentNode as TDomElement;
|
|
FCurrentModule:=Value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPackEditorFrame.SetCurrentPackage(Value: TDomElement);
|
|
begin
|
|
FCurrentPackage:=Value;
|
|
end;
|
|
|
|
procedure TPackEditorFrame.SetCurrentElement(E: TDomElement);
|
|
begin
|
|
FCurrentElement:=E;
|
|
end;
|
|
|
|
procedure TPackEditorFrame.SetCurrentTopic(T: TDomElement);
|
|
|
|
Var
|
|
N : TDomElement;
|
|
|
|
begin
|
|
If (FCurrentTopic<>T) then
|
|
begin
|
|
if assigned(T) then begin
|
|
N:=T.ParentNode as TDomElement;
|
|
if IsModuleNode(N) then
|
|
CurrentModule:=N
|
|
else if IsPackageNode(N) then
|
|
begin
|
|
CurrentModule:=Nil;
|
|
CurrentPackage:=N;
|
|
end
|
|
else
|
|
Raise Exception.Create('Unknown parent node for topic node '+TDomElement(T)['name']);
|
|
end;
|
|
FCurrentTopic:=T;
|
|
end;
|
|
end;
|
|
|
|
procedure TPackEditorFrame.SetDescriptionNode(Value: TDomNode);
|
|
begin
|
|
FDescriptionNode:=Value;
|
|
end;
|
|
|
|
procedure TPackEditorFrame.UpdateTree;
|
|
var n: TTreeNode;
|
|
begin
|
|
n := trvModules.Items[0];
|
|
while not Assigned(TDOMElement(n.Data)) do n := n.GetNext;
|
|
while Assigned(n) do
|
|
begin
|
|
UpdateNodeImage(n);
|
|
n := n.GetNext;
|
|
end;
|
|
if trvElements.Items.Count > 0 then
|
|
begin
|
|
n := trvElements.Items[0];
|
|
while not Assigned(TDOMElement(n.Data)) do n := n.GetNext;
|
|
while Assigned(n) do
|
|
begin
|
|
UpdateNodeImage(n);
|
|
n := n.GetNext;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPackEditorFrame.ExpandTree;
|
|
begin
|
|
trvModules.Items[0].Expand(True);
|
|
end;
|
|
|
|
|
|
{ ---------------------------------------------------------------------
|
|
TPackageEditor
|
|
---------------------------------------------------------------------}
|
|
|
|
Constructor TPackageEditor.Create(AOwner : TComponent);
|
|
|
|
Function NewMenuItem(ACaption : String; AOnClick : TNotifyEvent) : TMenuItem;
|
|
|
|
begin
|
|
Result:=TMenuItem.Create(Self);
|
|
Result.Caption:=ACaption;
|
|
Result.OnClick:=AOnClick;
|
|
end;
|
|
|
|
begin
|
|
Inherited;
|
|
Width:=300;
|
|
lblStructure.Caption := SFileStructure;
|
|
lblNodeStructure.Caption := SModuleElements;
|
|
// lblStructure.Hint := sfil
|
|
FERenameMenu:=NewMenuItem(SMenuRename,@MenuRenameClick);
|
|
FEDeleteMenu:=NewMenuItem(SMenuDelete,@MenuDeleteClick);
|
|
FEDeleteMenu.ShortCut := ShortCut(VK_DELETE, []);
|
|
FEExpandAllMenu:=NewMenuItem(SMenuExpandAll,@MenuExpandAllClick);
|
|
FECollapseAllMenu:=NewMenuItem(SMenuCollapseAll,@MenuCollapseAllClick);
|
|
PEMenu.Items.Add(FERenameMenu);
|
|
PEMenu.Items.Add(FEDeleteMenu);
|
|
PEMenu.Items.Add(NewMenuItem('-',nil));
|
|
PEMEnu.Items.Add(FEExpandAllMenu);
|
|
PEMenu.Items.Add(FECollapseAllMenu);
|
|
trvElements.PopupMenu:=PEMenu;
|
|
FMRenameMenu:=NewMenuItem(SMenuRename,@MenuRenameClick);
|
|
FMDeleteMenu:=NewMenuItem(SMenuDelete,@MenuDeleteClick);
|
|
PMMenu.Items.Add(FMRenameMenu);
|
|
PMMenu.Items.Add(FMDeleteMenu);
|
|
trvModules.PopupMenu:=PMMenu;
|
|
end;
|
|
|
|
Procedure TPackageEditor.SetDescriptionNode (Value : TDomNode);
|
|
|
|
begin
|
|
Inherited;
|
|
Refresh;
|
|
end;
|
|
|
|
|
|
procedure TPackEditorFrame.ModuleChanging(Sender: TObject; Node: TTreeNode;
|
|
var AllowChange: Boolean);
|
|
begin
|
|
if Sender=nil then ;
|
|
if Node=nil then ;
|
|
AllowChange:=True;
|
|
end;
|
|
|
|
Procedure TPackEditorFrame.ModuleChange(Sender: TObject; Node: TTreeNode);
|
|
Var
|
|
o : TDomElement;
|
|
begin
|
|
if Sender=nil then ;
|
|
If (Node<>Nil) then
|
|
begin
|
|
O:=TDomElement(Node.Data);
|
|
If (O<>Nil) then
|
|
If IsPackageNode(O) then
|
|
SelectPackage(O)
|
|
else if IsModuleNode(O) then
|
|
SelectModule(O)
|
|
else if IsTopicNode(O) then
|
|
SelectTopic(O)
|
|
end;
|
|
end;
|
|
|
|
procedure TPackEditorFrame.ElementChanging(Sender: TObject; Node: TTreeNode;
|
|
var AllowChange: Boolean);
|
|
begin
|
|
if Sender=nil then ;
|
|
if Node=nil then ;
|
|
AllowChange:=True;
|
|
end;
|
|
|
|
Procedure TPackEditorFrame.SelectElement(Sender : TDomElement);
|
|
|
|
begin
|
|
If IsElementNode(Sender) or IsModuleNode(Sender) or IsPackageNode(Sender) then
|
|
CurrentElement:=Sender
|
|
else // No valid node
|
|
CurrentElement:=Nil;
|
|
If Assigned(FOnSelectElement) then
|
|
OnSelectElement(Sender);
|
|
end;
|
|
|
|
Procedure TPackEditorFrame.ElementChange(Sender: TObject; Node: TTreeNode);
|
|
|
|
Var
|
|
o : TDomElement;
|
|
|
|
begin
|
|
if Sender=nil then ;
|
|
If (Node<>Nil) then
|
|
begin
|
|
O:=TDomElement(Node.Data);
|
|
SelectElement(O)
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure TPackEditorFrame.SelectModule(Sender : TDomElement);
|
|
begin
|
|
CurrentTopic:=Nil;
|
|
CurrentPackage:=Sender.ParentNode as TDomElement;
|
|
CurrentModule:=Sender;
|
|
CurrentElement:=Sender;
|
|
ShowModuleElements(FCurrentModule);
|
|
If Assigned(FOnSelectModule) then
|
|
FOnSelectModule(Sender);
|
|
end;
|
|
|
|
Procedure TPackEditorFrame.SelectPackage(Sender : TDomElement);
|
|
begin
|
|
CurrentElement:=Nil;
|
|
CurrentModule:=Nil;
|
|
CurrentTopic:=Nil;
|
|
CurrentPackage:=Sender;
|
|
ShowModuleElements(Nil);
|
|
If Assigned(FOnSelectPackage) then
|
|
FOnSelectPackage(Sender);
|
|
end;
|
|
|
|
Procedure TPackEditorFrame.SelectTopic(Sender : TDomElement);
|
|
Var
|
|
P : TDomElement;
|
|
|
|
begin
|
|
CurrentTopic:=Sender;
|
|
P:=FCurrentTopic.ParentNode as TDomElement;
|
|
if IsModuleNode(P) then
|
|
CurrentModule:=P
|
|
else if IsTopicNode(P) then
|
|
CurrentPackage:=P.ParentNode as TDomElement
|
|
else if IsPackageNode(P) then
|
|
CurrentPackage:=p
|
|
else
|
|
Raise Exception.CreateFmt(SErrUnknownDomElement,[P.NodeName]);
|
|
If Assigned(FOnSelectTopic) then
|
|
FOnSelectTopic(Sender);
|
|
end;
|
|
|
|
Function TPackageEditor.GetSelectedNode : TTreeNode;
|
|
|
|
begin
|
|
Result:=trvModules.Selected;
|
|
end;
|
|
|
|
Procedure TPackageEditor.MenuRenameClick(Sender : TObject);
|
|
|
|
Var
|
|
E : TDomElement;
|
|
|
|
begin
|
|
if Sender=nil then ;
|
|
E:=TDomElement(trvModules.Selected.Data);
|
|
If Assigned(E) then
|
|
If IsPackageNode(E)then
|
|
RenamePackage(E)
|
|
else if IsModuleNode(E) then
|
|
RenameModule(E)
|
|
Else if IsTopicNode(E) then
|
|
RenameTopic(E)
|
|
else if IsElementNode(E) then
|
|
RenameElement(E)
|
|
end;
|
|
|
|
|
|
Procedure TPackageEditor.MenuDeleteClick(Sender : TObject);
|
|
|
|
Var
|
|
E : TDomElement;
|
|
|
|
begin
|
|
If (Sender=FEDeleteMenu) then
|
|
begin
|
|
E:=TDomElement(trvElements.Selected.Data);
|
|
If IsElementNode(E) then
|
|
DeleteElement(E);
|
|
end
|
|
else
|
|
begin
|
|
E:=TDomElement(trvModules.Selected.Data);
|
|
If IsPackageNode(E) then
|
|
DeleteNode(SDeletePackage,trvModules.Selected,E)
|
|
else if IsModuleNode(E) then
|
|
DeleteNode(SDeleteModule,trvModules.Selected,E)
|
|
else if IsTopicNode(E) then
|
|
DeleteNode(SDeleteTopic,trvModules.Selected,E)
|
|
end;
|
|
end;
|
|
|
|
procedure TPackageEditor.MenuCollapseAllClick(Sender: TObject);
|
|
var
|
|
Node: TTreeNode;
|
|
begin
|
|
if Sender=nil then ;
|
|
trvElements.FullCollapse;
|
|
Node := trvElements.Items.GetFirstNode;
|
|
if Node<>nil then
|
|
Node.Expand(False);
|
|
end;
|
|
|
|
procedure TPackageEditor.MenuExpandAllClick(Sender: TObject);
|
|
begin
|
|
if Sender=nil then ;
|
|
trvElements.FullExpand;
|
|
end;
|
|
|
|
|
|
Procedure TPackageEditor.SetModuleNode(N : TTreeNode);
|
|
|
|
begin
|
|
If N<>Nil then
|
|
begin
|
|
trvModules.Selected:=N;
|
|
ModuleChange(trvModules,N);
|
|
end
|
|
else
|
|
Refresh;
|
|
end;
|
|
|
|
Procedure TPackageEditor.DeleteNode(Msg : String; N : TTreeNode; E : TDomElement);
|
|
|
|
Var
|
|
P : TTreeNode;
|
|
|
|
begin
|
|
If (Not ConfirmDelete) or
|
|
(MessageDlg(Format(Msg,[E['name']]),mtConfirmation,[mbYes,mbNo],0)=mrYes) then
|
|
begin
|
|
P:=GetNextNode(N);
|
|
trvModules.Items.Delete(N);
|
|
FModified:=True;
|
|
SetModuleNode(P);
|
|
end;
|
|
end;
|
|
|
|
Function TPackageEditor.NewName(ATitle : String;Var AName : String) : Boolean;
|
|
begin
|
|
Result:=false;
|
|
With TNewNodeForm.Create(Self) do
|
|
Try
|
|
Caption:=ATitle;
|
|
ENodeName.Text:=AName;
|
|
If (ShowModal=mrOK) Then begin
|
|
AName:=ENodeName.Text;
|
|
Result:=AName<>'';
|
|
end;
|
|
Finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
Procedure TPackageEditor.RenameNode(Msg : String; N : TTreeNode);
|
|
|
|
Var
|
|
E : TDomElement;
|
|
S : String;
|
|
|
|
begin
|
|
E:=TDomElement(N.Data);
|
|
S:=E['name'];
|
|
If NewName(Msg,S) then
|
|
begin
|
|
E['name']:=S;
|
|
N.Text:=S;
|
|
FModified:=True;
|
|
end;
|
|
end;
|
|
|
|
Function TPackageEditor.CreateElementNode(E : TDomelement) : TTreeNode;
|
|
begin // FModuleNode
|
|
Result:=trvElements.Items.AddChild(trvElements.Selected,GetElementName(E));
|
|
Result.Data:=E;
|
|
UpdateNodeImage(Result);
|
|
end;
|
|
|
|
Procedure TPackageEditor.DeleteElementNode(N : TTreeNode);
|
|
|
|
procedure RemoveAllChildren(node: TTreeNode);
|
|
var sl: Integer; de: TDOMElement;
|
|
begin
|
|
sl := node.Level;
|
|
node := node.GetFirstChild;
|
|
while Assigned(node) and (node.Level > sl) do
|
|
begin
|
|
de := TDomElement(node.Data);
|
|
de.ParentNode.RemoveChild(de);
|
|
node := node.GetNext;
|
|
end;
|
|
end;
|
|
|
|
Var
|
|
Reposition : Boolean;
|
|
P : TTreeNode;
|
|
d: TDomElement;
|
|
begin
|
|
Reposition:=(TDomElement(N.Data)=CurrentElement) and (CurrentElement<>Nil) ;
|
|
d := TDomElement(N.Data);
|
|
d.ParentNode.RemoveChild(d);
|
|
RemoveAllChildren(N);
|
|
P:=GetNextNode(N);
|
|
trvElements.Items.Delete(N);
|
|
FModified:=True;
|
|
If Reposition then
|
|
begin
|
|
trvElements.Selected:=P;
|
|
ElementChange(trvElements,P);
|
|
end;
|
|
end;
|
|
|
|
Procedure TPackageEditor.DeleteElement(E : TDomElement);
|
|
|
|
Var
|
|
N : TTreeNode;
|
|
|
|
begin
|
|
N:=FindElementNode(E,Nil);
|
|
If (N<>Nil) then
|
|
DeleteElementNode(N);
|
|
end;
|
|
|
|
Procedure TPackageEditor.DeletePackage(P : TDomElement);
|
|
|
|
Var
|
|
N : TTreeNode;
|
|
|
|
begin
|
|
N:=FindPackageNode(P);
|
|
If N<>NIl then
|
|
DeleteNode(SDeletePackage,N,P);
|
|
end;
|
|
|
|
|
|
Procedure TPackageEditor.DeleteModule(M : TDomElement);
|
|
|
|
Var
|
|
N : TTreeNode;
|
|
|
|
begin
|
|
N:=FindModuleNodeInNode(M,Nil);
|
|
If N<>NIl then
|
|
DeleteNode(SDeleteModule,N,M);
|
|
end;
|
|
|
|
|
|
Procedure TPackageEditor.DeleteTopic(T : TDomElement);
|
|
|
|
Var
|
|
N : TTreeNode;
|
|
|
|
begin
|
|
N:=FindTopicNodeInNode(T,Nil);
|
|
If N<>NIl then
|
|
DeleteNode(SDeleteTopic,N,T);
|
|
end;
|
|
|
|
|
|
Procedure TPackageEditor.RenamePackage(P : TDomElement);
|
|
|
|
Var
|
|
N : TTreeNode;
|
|
|
|
begin
|
|
N:=FindPackageNode(P);
|
|
If N<>NIl then
|
|
RenameNode(SRenamePackage,N);
|
|
end;
|
|
|
|
|
|
Procedure TPackageEditor.RenameModule(M : TDomElement);
|
|
|
|
Var
|
|
N : TTreeNode;
|
|
|
|
begin
|
|
N:=FindModuleNodeInNode(M,Nil);
|
|
If N<>NIl then
|
|
RenameNode(SRenameModule,N);
|
|
end;
|
|
|
|
|
|
Procedure TPackageEditor.RenameTopic(T : TDomElement);
|
|
|
|
Var
|
|
N : TTreeNode;
|
|
|
|
begin
|
|
N:=FindTopicNodeInNode(T,Nil);
|
|
If N<>NIl then
|
|
RenameNode(SRenameTopic,N);
|
|
end;
|
|
|
|
procedure DebugElement(Element: TDomElement);
|
|
var
|
|
Level: integer;
|
|
const
|
|
NType:Array[0..12] of String[30] =
|
|
(
|
|
'0:UNKNOWN',
|
|
'1:ELEMENT_NODE',
|
|
'2:ATTRIBUTE_NODE',
|
|
'3:TEXT_NODE',
|
|
'4:CDATA_SECTION_NODE',
|
|
'5:ENTITY_REFERENCE_NODE',
|
|
'6:ENTITY_NODE',
|
|
'7:PROCESSING_INSTRUCTION_NODE',
|
|
'8:COMMENT_NODE',
|
|
'9:DOCUMENT_NODE',
|
|
'10:DOCUMENT_TYPE_NODE',
|
|
'11:DOCUMENT_FRAGMENT_NODE',
|
|
'12:NOTATION_NODE'
|
|
);
|
|
function GetLevelSpc: String;
|
|
begin
|
|
SetLength(Result, Level*2);
|
|
FillChar(Result[1], Level*2, ' ');
|
|
end;
|
|
procedure DebugNodes(Node: TDomNode);
|
|
begin
|
|
Node := Node.FirstChild;
|
|
while node<>nil do begin
|
|
DebugLn(GetLevelSpc, 'Node=',Node.NodeName,' Type=',NType[Node.NodeType],' Value=',Node.NodeValue);
|
|
if (node.NodeType = ELEMENT_NODE) then begin
|
|
Inc(Level);
|
|
DebugNodes(Node);
|
|
Dec(Level);
|
|
end;
|
|
Node := Node.NextSibling;
|
|
end;
|
|
end;
|
|
begin
|
|
if assigned(Element) then begin
|
|
debugLn('Element: ', Element['name'],': ');
|
|
level := 1;
|
|
DebugNodes(Element);
|
|
end else
|
|
debugLn('Element <nil>');
|
|
end;
|
|
|
|
|
|
procedure TPackageEditor.UpdateSelectedNodeStatus;
|
|
begin
|
|
if trvElements.Selected <> nil then
|
|
UpdateNodeImage(trvElements.Selected);
|
|
end;
|
|
|
|
Procedure TPackageEditor.RenameElement(E : TDomElement);
|
|
|
|
Var
|
|
N : TTreeNode;
|
|
|
|
begin
|
|
N:=FindElementNode(E,Nil);
|
|
If N<>NIl then
|
|
RenameNode(SRenameElement,N);
|
|
end;
|
|
|
|
Procedure TPackEditorFrame.ClearElements;
|
|
begin
|
|
trvElements.Items.Clear;
|
|
FModuleNode:=Nil;
|
|
end;
|
|
|
|
Procedure TPackEditorFrame.ShowModuleElements(Module : TDomElement);
|
|
Var
|
|
Node : TDomNode;
|
|
SNode,PNode,TNode : TTreeNode;
|
|
S : TStringList;
|
|
I,L : Integer;
|
|
N,PN : String;
|
|
|
|
begin
|
|
ClearElements;
|
|
If Assigned(Module) then
|
|
begin
|
|
FModuleNode:=trvElements.Items.Add(Nil,Module['name']);
|
|
FModuleNode.Data:=Module;
|
|
UpdateNodeImage(FModuleNode);
|
|
S:=TStringList.Create;
|
|
Try
|
|
// get sorted list of elements
|
|
Node:=Module.FirstChild;
|
|
While Assigned(Node) do
|
|
begin
|
|
If IsElementNode(Node) then
|
|
S.AddObject(TDomElement(Node)['name'],Node);
|
|
Node:=Node.NextSibling;
|
|
end;
|
|
S.Sorted:=True;
|
|
// root node
|
|
TNode:=FModuleNode;
|
|
// process list of elements, create levels
|
|
trvElements.Items.BeginUpdate;
|
|
try
|
|
For I:=0 to S.Count-1 do
|
|
begin
|
|
PNode:=Nil;
|
|
SNode:=TNode;
|
|
N:=S[i];
|
|
// look for a tentative new parents
|
|
While (SNode<>FModuleNode) and (PNode=Nil) do
|
|
begin
|
|
PN:=TDomElement(SNode.Data)['name']+'.';
|
|
L:=Length(PN);
|
|
If CompareText(Copy(N,1,L),PN)=0 then
|
|
PNode:=SNode;
|
|
SNode:=SNode.Parent;
|
|
end;
|
|
If (PNode=Nil) then
|
|
PNode:=FModuleNode
|
|
else
|
|
System.Delete(N,1,L);
|
|
TNode:=trvElements.Items.AddChild(PNode,N);
|
|
TNode.Data:=S.Objects[i];
|
|
UpdateNodeImage(TNode);
|
|
end;
|
|
finally
|
|
trvElements.Items.EndUpdate;
|
|
end;
|
|
Finally
|
|
S.Free;
|
|
end;
|
|
FModuleNode.Expand(False);
|
|
trvElements.Selected:=FModuleNode;
|
|
ElementChange(trvElements,FModuleNode);
|
|
end;
|
|
end;
|
|
|
|
Function TPackageEditor.AddDomNode(E : TDomElement;Nodes: TTreeNodes;AParent : TTreeNode) : TTreeNode;
|
|
|
|
begin
|
|
Result:=Nodes.AddChild(AParent,E['name']);
|
|
Result.Data:=E;
|
|
end;
|
|
|
|
Procedure TPackageEditor.DoTopicNode(Node : TDomElement;Nodes: TTreeNodes;AParent : TTreeNode);
|
|
|
|
Var
|
|
N : TTreeNode;
|
|
SubNode : TDomNode;
|
|
|
|
begin
|
|
N:=Nodes.AddChild(AParent,Node['name']);
|
|
N.Data:=Node;
|
|
UpdateNodeImage(N);
|
|
SubNode:=Node.FirstChild;
|
|
While (SubNode<>Nil) do
|
|
begin
|
|
If IsTopicNode(SubNode) then
|
|
DoTopicNode(SubNode as TDomElement,Nodes,N);
|
|
SubNode:=SubNode.NextSibling;
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure TPackageEditor.Refresh;
|
|
|
|
var
|
|
Node,SubNode,SSnode : TDomNode;
|
|
R,P,M : TTreeNode;
|
|
|
|
begin
|
|
trvModules.Items.BeginUpdate;
|
|
trvModules.Items.Clear;
|
|
R:=trvModules.Items.add(Nil,SPackages);
|
|
R.ImageIndex := 0;
|
|
R.SelectedIndex := 0;
|
|
If Assigned(FDescriptionNode) then
|
|
begin
|
|
Node:=FDescriptionNode.FirstChild;
|
|
While Assigned(Node) do
|
|
begin
|
|
If IsPackageNode(Node) then
|
|
begin
|
|
P:=AddDomNode(Node as TDomElement,trvModules.Items,R);
|
|
UpdateNodeImage(P);
|
|
SubNode:=Node.FirstChild;
|
|
While Assigned(SubNode) do
|
|
begin
|
|
If IsModuleNode(SubNode) then
|
|
begin
|
|
M:=AddDomNode(SubNode as TDomElement,trvModules.Items,P);
|
|
UpdateNodeImage(M);
|
|
SSNode:=SubNode.FirstChild;
|
|
While (SSNode<>Nil) do
|
|
begin
|
|
if IsTopicNode(SSNode) then
|
|
DoTopicNode(SSNode as TDomElement,trvModules.Items,M);
|
|
SSNode:=SSNode.NextSibling;
|
|
end;
|
|
end
|
|
else if IsTopicNode(SubNode) then
|
|
DoTopicNode(SubNode as TDomElement,trvModules.Items,P);
|
|
SubNode:=SubNode.NextSibling;
|
|
end;
|
|
end;
|
|
Node:=Node.NextSibling;
|
|
end;
|
|
end;
|
|
trvModules.Items.EndUpdate;
|
|
CurrentModule:=Nil;
|
|
FModified:=False;
|
|
end;
|
|
|
|
Function TPackageEditor.FindPackageNode(P : TDomElement) : TTreeNode;
|
|
begin
|
|
Result:=Nil;
|
|
Result:=SubNodeWithElement(trvModules.Items[0],P);
|
|
If (Result=Nil) then
|
|
Raise Exception.CreateFmt(SErrNoNodeForPackage,[P['name']]);
|
|
end;
|
|
|
|
Function TPackageEditor.FindModuleNodeInNode(M : TDomElement; N : TTreeNode) : TTreeNode;
|
|
|
|
Var
|
|
P : TTreeNode;
|
|
|
|
begin
|
|
Result:=Nil;
|
|
If (N<>Nil) then
|
|
P:=N
|
|
else
|
|
P:=FindPackageNode(M.ParentNode as TDomElement);
|
|
Result:=SubNodeWithElement(P,M);
|
|
If (Result=Nil) then
|
|
Raise Exception.CreateFmt(SErrNoNodeForModule,[M['name']]);
|
|
end;
|
|
|
|
Function TPackageEditor.FindTopicNodeInNode(M : TDomElement; N : TTreeNode) : TTreeNode;
|
|
|
|
Var
|
|
P : TTreeNode;
|
|
E : TDomElement;
|
|
|
|
begin
|
|
Result:=Nil;
|
|
If (N<>Nil) then
|
|
P:=N
|
|
else
|
|
begin
|
|
E:=M.ParentNode as TDomElement;
|
|
If IsModuleNode(E) then
|
|
P:=FindModuleNodeInNode(E,FindPackageNode(E.ParentNode as TDomElement))
|
|
else if IsTopicNode(E) then
|
|
// Assumes that we can only nest 2 deep inside package node !!
|
|
P:=FindTopicNodeInNode(E,FindPackageNode(E.ParentNode as TDomElement))
|
|
else if IsPackageNode(E) then
|
|
P:=FindPackageNode(E);
|
|
end;
|
|
Result:=SubNodeWithElement(P,M);
|
|
If (Result=Nil) then
|
|
Raise Exception.CreateFmt(SErrNoNodeForTopic,[M['name']]);
|
|
end;
|
|
|
|
Function TPackageEditor.FindElementNode(E: TDomElement; N: TTreeNode): TTreeNode;
|
|
|
|
Var
|
|
P : TTreeNode;
|
|
|
|
begin
|
|
If IsModuleNode(E) then
|
|
Result:=FModuleNode
|
|
else
|
|
begin
|
|
Result:=Nil;
|
|
If (N<>Nil) then
|
|
P:=N
|
|
else
|
|
P:=FModuleNode;
|
|
Result:=SubNodeWithElement(P,E);
|
|
end;
|
|
end;
|
|
|
|
Procedure TPackageEditor.AddElement(E : TDomElement);
|
|
|
|
Var
|
|
N : TTreeNode;
|
|
|
|
begin
|
|
N:=CreateElementNode(E);
|
|
SetCurrentElementNode(N);
|
|
FModified:=True;
|
|
end;
|
|
|
|
|
|
Procedure TPackageEditor.SetCurrentPackage(Value : TDomElement);
|
|
|
|
begin
|
|
if (Value<>CurrentPackage) then
|
|
begin
|
|
Inherited;
|
|
If (Value<>Nil) then
|
|
SetCurrentPackageNode(FindPackageNode(Value));
|
|
end;
|
|
end;
|
|
|
|
Procedure TPackageEditor.SetCurrentPackageNode(N : TTreeNode);
|
|
|
|
begin
|
|
trvModules.Selected:=N;
|
|
end;
|
|
|
|
Procedure TPackageEditor.SetCurrentModule(Value : TDomElement);
|
|
begin
|
|
If (Value<>CurrentModule) then
|
|
begin
|
|
Inherited;
|
|
If Assigned(Value) then
|
|
SetCurrentModuleNode(FindModuleNodeInNode(Value,Nil))
|
|
else
|
|
ClearElements;
|
|
FCurrentModule:=Value
|
|
end;
|
|
end;
|
|
|
|
Procedure TPackageEditor.SetCurrentModuleNode(N : TTreeNode);
|
|
|
|
Var
|
|
P : TTreeNode;
|
|
|
|
begin
|
|
P:=FindPackageNode(CurrentPackage);
|
|
If Assigned(P) then
|
|
P.Expand(False);
|
|
trvModules.Selected:=N;
|
|
Application.ProcessMessages;
|
|
end;
|
|
|
|
Procedure TPackageEditor.SetCurrentTopic(T : TDomElement);
|
|
|
|
Var
|
|
N : TDomElement;
|
|
PN : TTreeNode;
|
|
|
|
begin
|
|
If (CurrentTopic<>T) then
|
|
begin
|
|
if assigned(T) then
|
|
begin
|
|
N:=T.ParentNode as TDomElement;
|
|
if IsModuleNode(N) then
|
|
begin
|
|
CurrentModule:=N;
|
|
PN:=FindModuleNodeInNode(N,Nil);
|
|
end
|
|
else if IsPackageNode(N) then
|
|
begin
|
|
CurrentModule:=Nil;
|
|
CurrentPackage:=N;
|
|
PN:=FindPackageNode(n);
|
|
end;
|
|
SetCurrentTopicNode(FindTopicNodeInNode(T,PN));
|
|
end;
|
|
end;
|
|
Inherited;
|
|
end;
|
|
|
|
Procedure TPackageEditor.SetCurrentTopicNode(T : TTreeNode);
|
|
|
|
begin
|
|
T.Parent.Expand(False);
|
|
trvModules.Selected:=T;
|
|
If (CurrentElement<>Nil) then
|
|
CurrentElement:=Nil;
|
|
end;
|
|
|
|
procedure TPackEditorFrame.UpdateNodeImage(N: TTreeNode);
|
|
|
|
procedure SetNodeImage(N: TTreeNode; Index: Integer);
|
|
begin
|
|
n.ImageIndex := Index;
|
|
n.SelectedIndex := Index;
|
|
end;
|
|
|
|
function GetImgIndex(DN: TDomNode): Integer;
|
|
var
|
|
N: TDomNode;
|
|
HasShort, HasDescr, HasSealso, HasExample, HasErrors: Boolean;
|
|
begin
|
|
Result := ImgIndxNew;
|
|
N := DN.FirstChild;
|
|
HasShort := False; HasDescr := False;
|
|
HasErrors := False;
|
|
HasExample := False; HasSealso := False;
|
|
while Assigned(N) do
|
|
begin
|
|
if (N.NodeName = 'short') and (N.TextContent <> '') then
|
|
begin HasShort := True; Result := ImgIndxEdited; end;
|
|
if (N.NodeName = 'descr') and (N.TextContent <> '') then
|
|
begin HasDescr := True; Result := ImgIndxEdited; end;
|
|
if (N.NodeName = 'seealso') and (N.HasChildNodes) then
|
|
begin HasSealso := True; Result := ImgIndxEdited; end;
|
|
if (N.NodeName = 'example') and (N.Attributes[0].TextContent <> '') then
|
|
begin HasExample := True; Result := ImgIndxEdited; end;
|
|
if (N.NodeName = 'errors') and (N.TextContent <> '') then
|
|
begin HasErrors := True; Result := ImgIndxEdited; end;
|
|
N := N.NextSibling;
|
|
end;
|
|
if HasShort or HasDescr or HasSealso or HasExample or HasErrors then
|
|
Result := ImgIndxEdited;
|
|
end;
|
|
|
|
var
|
|
ImgIndex: Integer;
|
|
Element: TDomElement;
|
|
begin
|
|
if Assigned(N) then
|
|
begin
|
|
Element := TDomElement(N.Data);
|
|
if not Assigned(Element) then
|
|
Exit;
|
|
ImgIndex := GetImgIndex(Element);
|
|
SetNodeImage(N, ImgIndex);
|
|
end;
|
|
end;
|
|
|
|
function TPackageEditor.GetElementName(E: TDomElement): String;
|
|
var fn: String;
|
|
begin
|
|
fn := E['name'];
|
|
Result := RightStr(fn, Length(fn) - RPos('.', fn));
|
|
end;
|
|
|
|
Procedure TPackageEditor.SetCurrentElement(E : TDomElement);
|
|
var
|
|
SelNode:TTreeNode;
|
|
begin
|
|
If (E<>FCurrentElement) and (E <> nil) then
|
|
begin
|
|
Inherited;
|
|
If E.NodeName='module' then
|
|
CurrentModule:=E
|
|
else
|
|
CurrentModule:=E.ParentNode as TDomElement;
|
|
SelNode:=trvElements.Selected;
|
|
//avoid selecting an already selected node (occurs in OnChange event)
|
|
if (SelNode = nil) or (SelNode.Data <> Pointer(E)) then
|
|
SetCurrentElementNode(FindElementNode(E,Nil));
|
|
end;
|
|
end;
|
|
|
|
Procedure TPackageEditor.SetCurrentElementNode(N : TTreeNode);
|
|
|
|
begin
|
|
trvElements.Selected:=N;
|
|
end;
|
|
|
|
end.
|
|
|
|
|
|
|