{*
 * @(#) sdesignf.pas - System Designer program ('file view' module).
 * (c) 1997 Ivan Maidanski <ivmai@chat.ru> http://ivmai.chat.ru
 * Freeware program source. All rights reserved.
 **
 * Language: Delphi
 * Tested with: Borland Delphi DeskTop 2.01 for Windows 95
 * Last modified: 1997-04-18 15:05:00 GMT+04:00
 *}

unit SDesignF;

interface

uses
  Forms, ComCtrls, Classes, Controls, SysUtils, Dialogs, Clipbrd, StdCtrls;

{$EXTENDEDSYNTAX ON}
{$LONGSTRINGS ON}

type
  TProjectForm = class(TForm)
    DataBaseView: TTreeView;
    ItemView: TListView;
    StatusLine: TStatusBar;
    SaveDlg: TSaveDialog;
    FindDlg: TFindDialog;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure SelectorChanged(Sender: TObject; Node: TTreeNode);
    procedure EndEditing(Sender: TObject; Node: TTreeNode; var S: string);
  private
    FileName: String;
    Number: Integer;
    Modified: Boolean;
    procedure SetFileName(const FName: String);
    procedure SetModified;
    procedure ItemViewUpdate;
    procedure StatusBarUpdate;
    function GetItemFullName(Node: TTreeNode): String;
    function NodeToStr(Node: TTreeNode; StLevel: Integer): String;
    function TreeToText(Node: TTreeNode): String;
    function InsertItemFromStr(Node: TTreeNode;
                               const ItemStr: String): TTreeNode;
    procedure InsertTreeFromText(Node: TTreeNode; const TreeText: String);
    procedure DeleteCurItem;
    procedure ModifyCurItem;
    procedure SetCurItemValue(const Value: String);
    procedure RenameCurItem(const NewItemName: String);
    procedure InsertCurItem(const NewItemName,Value: String);
    procedure CopyToClipboard(Node: TTreeNode);
    procedure InsertFromClipboard(Node: TTreeNode);
  public
    constructor CreateForm(AOwner: TComponent; const FName: String;
                           ReadOnly: Boolean; FormNum: Integer);
    procedure SaveToFile(const FName: String);
    function GetFileName: String;
    function GetProjectName: String;
    function IsModified: Boolean;
    function IsReadOnly: Boolean;
    procedure SaveClick;
    procedure SaveAsClick;
    procedure InsertItemClick;
    procedure ModifyItemClick;
    procedure RenameItemClick;
    procedure DeleteItemClick;
    procedure FindItemClick;
    procedure CutToClipboardClick;
    procedure CopyToClipboardClick;
    procedure PasteFromClipboardClick;
  end;

implementation

{$R sdesignf.dfm}

{$BOOLEVAL OFF}
{$IOCHECKS ON}

uses
   SDesignM, SDesignE;

function FileToText(const FName: String): String;
var
  F: TextFile;
  Line,Text: String;
begin
  Text:='';
  AssignFile(F,FName);
  try
    Reset(F);
    while not EOF(F)
      do begin
           ReadLn(F,Line);
           Text:=Text+AdjustLineBreaks(Line+#13#10);
         end;
  finally
    CloseFile(F);
  end;
  FileToText:=Text;
end;

procedure WriteTextToFile(const Text,FName: String);
var
  F: TextFile;
begin
  AssignFile(F,FName);
  try
    ReWrite(F);
    Write(F,Text);
  finally
    CloseFile(F);
  end;
end;

function GetLineFromText(const Text: String; var Pos: LongInt): String;
var
  OldPos,Len: LongInt;
begin
  OldPos:=Pos;
  Len:=Length(Text);
  while (Pos<=Len) and (Text[Pos]<>#13)
    do Inc(Pos);
  GetLineFromText:=Copy(Text,OldPos,Pos-OldPos);
  if Pos<=Len
    then Inc(Pos);
  if (Pos<=Len) and (Text[Pos]=#10)
    then Inc(Pos);
end;

constructor TProjectForm.CreateForm(AOwner: TComponent; const FName: String;
                                    ReadOnly: Boolean; FormNum: Integer);
begin
  inherited Create(AOwner);
  with DataBaseView
    do begin
         if Length(FName)>0
           then InsertTreeFromText(Selected,FileToText(FName))
           else InsertTreeFromText(Selected,'/');
         if Items.Count>0
           then Selected:=Items[0];
       end;
  DataBaseView.ReadOnly:=ReadOnly;
  Number:=FormNum;
  SetFileName(FName);
end;

procedure TProjectForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  Button: Word;
begin
  if Modified
    then begin
           Button:=MessageDlg('Save changes to project '+GetProjectName+'?',
                              mtConfirmation,mbYesNoCancel,0);
           if Button<>mrNo
             then CanClose:=False;
           if Button=mrYes
             then begin
                    SaveClick;
                    if not Modified
                      then CanClose:=True;
                  end;
         end;
end;

procedure TProjectForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  DesignerForm.ChildClosed(Self);
  Action:=caFree;
end;

procedure TProjectForm.FormActivate(Sender: TObject);
begin
  DesignerForm.ChildFocused(Self);
end;

procedure TProjectForm.FormResize(Sender: TObject);
begin
  DataBaseView.Width:=ClientWidth div 2;
  with ItemView
    do begin
         Columns.Items[0].Width:=ClientWidth div 2;
         Columns.Items[1].Width:=ClientWidth-Columns.Items[0].Width;
       end;
end;

procedure TProjectForm.ItemViewUpdate;
var
  Node: TTreeNode;
  NewItem: TListItem;
begin
  ItemView.ReadOnly:=False;
  ItemView.Items.Clear;
  with DataBaseView.Selected
    do begin
         Node:=GetFirstChild;
         while Node<>nil
           do begin
                NewItem:=ItemView.Items.Add;
                NewItem.Caption:=Node.Text;
                if Node.Data<>nil
                  then NewItem.SubItems.Add(PString(Node.Data)^);
                Node:=GetNextChild(Node);
              end;
       end;
  ItemView.ReadOnly:=True;
end;

procedure TProjectForm.StatusBarUpdate;
begin
  StatusLine.SimpleText:='';
  with DataBaseView
    do if Selected<>nil
         then StatusLine.SimpleText:=GetItemFullName(Selected);
end;

procedure TProjectForm.SaveClick;
begin
  if Length(FileName)>0
    then SaveToFile(FileName)
    else if SaveDlg.Execute
           then SaveToFile(SaveDlg.FileName);
end;

procedure TProjectForm.SaveAsClick;
begin
  if Length(FileName)>0
    then SaveDlg.FileName:=FileName;
  if SaveDlg.Execute
    then SaveToFile(SaveDlg.FileName);
end;

procedure TProjectForm.SaveToFile(const FName: String);
begin
  try
    WriteTextToFile(TreeToText(DataBaseView.Items[0]),FName);
    SetFileName(FName);
  except
    on EInOutError
      do MessageDlg('Cannot save project.',mtInformation,[mbOk],0);
  end;
end;

procedure TProjectForm.SetFileName(const FName: String);
begin
  Modified:=False;
  FileName:=FName;
  Caption:='SDesign project: ';
  if Length(FileName)>0
    then Caption:=Caption+GetProjectName
    else Caption:=Caption+'<Untitled> '+IntToStr(Number);
  DesignerForm.ChildChanged(Self);
end;

function TProjectForm.GetFileName: String;
begin
  GetFileName:=FileName;
end;

function TProjectForm.GetProjectName: String;
var
  Ind,Len: Integer;
begin
  GetProjectName:='';
  Len:=Length(FileName);
  if Len>0
    then begin
           Ind:=Len;
           while (Ind>1) and (FileName[Ind]<>'.') and
                  (FileName[Ind-1]<>'/') and (FileName[Ind-1]<>'\')
             do Dec(Ind);
           if (Ind>1) and (FileName[Ind-1]<>'/') and (FileName[Ind-1]<>'\')
             then begin
                    Dec(Ind);
                    Len:=Ind;
                    while (Ind>1) and (FileName[Ind-1]<>'/') and
                           (FileName[Ind-1]<>'\')
                      do Dec(Ind);
                  end;
           GetProjectName:=Copy(FileName,Ind,Len-Ind+1);
         end;
end;

procedure TProjectForm.SetModified;
begin
  if not Modified
    then begin
           Modified:=True;
           DesignerForm.ChildChanged(Self);
         end;
end;

function TProjectForm.IsModified: Boolean;
begin
  IsModified:=Modified;
end;

function TProjectForm.IsReadOnly: Boolean;
begin
  IsReadOnly:=DataBaseView.ReadOnly;
end;

function TProjectForm.GetItemFullName(Node: TTreeNode): String;
var
  Name: String;
begin
  Name:=Node.Text;
  while Node.Level>0
    do begin
         Node:=Node.Parent;
         Name:='//'+Name;
         if (Length(Node.Text)>0) and (Node.Text[1]<>'/')
           then Name:=Node.Text+Name;
       end;
  GetItemFullName:=Name;
end;

function TProjectForm.NodeToStr(Node: TTreeNode; StLevel: Integer): String;
var
  Line: String;
begin
  Line:='';
  if StLevel<=Node.Level
    then begin
           StLevel:=Node.Level-StLevel;
           while StLevel>0
             do begin
                  Line:=Line+' ';
                  Dec(StLevel);
                end;
           Line:=Line+Node.Text;
           if Node.Data<>nil
             then Line:=Line+' ='+PString(Node.Data)^;
         end;
  NodeToStr:=Line+#13#10;
end;

function TProjectForm.TreeToText(Node: TTreeNode): String;
var
  S: String;
  Level: Integer;
begin
  S:='';
  Level:=Node.Level;
  repeat
    S:=S+NodeToStr(Node,Level);
    Node:=Node.GetNext;
  until (Node=nil) or (Node.Level<=Level);
  TreeToText:=S;
end;

function TProjectForm.InsertItemFromStr(Node: TTreeNode;
                                        const ItemStr: String): TTreeNode;
var
  Ind: Integer;
  ItemName: String;
begin
  ItemName:=Trim(ItemStr);
  Ind:=Pos('=',ItemName);
  with DataBaseView
    do if Ind>1
         then InsertItemFromStr:=Items.AddChildObject(Node,
                                                      Copy(ItemName,1,Ind-1),
                                                      NewStr(Copy(ItemName,
                                                      Ind+1,Length(ItemName))))
         else InsertItemFromStr:=Items.AddChild(Node,ItemName);
end;

procedure TProjectForm.InsertTreeFromText(Node: TTreeNode;
                                          const TreeText: String);
var
  Len: Integer;
  PLen: ^Integer;
  Pos: LongInt;
  LevelList: TList;
  Line: String;
begin
  LevelList:=TList.Create();
  Pos:=1;
  Line:=GetLineFromText(TreeText,Pos);
  Len:=Length(Line);
  while Len>0
    do begin
         Line:=TrimLeft(Line);
         Len:=Len-Length(Line);
         with LevelList
           do while (Count>0) and (Integer(Items[0]^)>=Len)
                do begin
                     Node:=Node.Parent;
                     Dispose(Items[0]);
                     Remove(Items[0]);
                   end;
         if (LevelList.Count=0) or (Integer(LevelList.Items[0]^)<Len)
           then begin
                  Node:=InsertItemFromStr(Node,Line);
                  New(PLen);
                  PLen^:=Len;
                  LevelList.Insert(0,PLen);
                end;
         Line:=GetLineFromText(TreeText,Pos);
         Len:=Length(Line);
       end;
  with LevelList
    do while Count>0
         do begin
              Dispose(Items[0]);
              Remove(Items[0]);
            end;
  LevelList.Free;
end;

procedure TProjectForm.DeleteCurItem;
begin
  with DataBaseView
    do begin
         Selected.Delete;
         StatusBarUpdate;
         ItemViewUpdate;
         SetModified;
       end;
end;

procedure TProjectForm.SetCurItemValue(const Value: String);
begin
  with DataBaseView.Selected
    do begin
         if Data<>nil
           then Dispose(Data);
         if Length(Value)>0
           then Data:=NewStr(Value)
           else Data:=nil;
       end;
  SetModified;
end;

procedure TProjectForm.RenameCurItem(const NewItemName: String);
begin
  with DataBaseView
    do if Selected<>Items[0]
         then Selected.Text:=NewItemName;
  SetModified;
end;

procedure TProjectForm.InsertCurItem(const NewItemName,Value: String);
begin
  with DataBaseView
    do if Length(Value)>0
         then Selected:=Items.AddChildObject(Selected,NewItemName,
                                             NewStr(Value))
         else Selected:=Items.AddChild(Selected,NewItemName);
  SetModified;
end;

procedure TProjectForm.ModifyCurItem;
var
  Value: String;
  ModifyForm: TModifyForm;
begin
  if DataBaseView.Selected<>nil
    then begin
           ModifyForm:=TModifyForm.Create(Self);
           Value:='';
           with DataBaseView.Selected
             do begin
                  if Data<>nil
                    then Value:=PString(Data)^;
                  if ModifyForm.Execute(Text,Value)
                    then SetCurItemValue(Value);
                end;
           ModifyForm.Free;
         end;
end;

procedure TProjectForm.InsertItemClick;
begin
  if not (IsReadOnly or DataBaseView.IsEditing)
    then begin
           InsertCurItem('?','');
           RenameItemClick;
         end;
end;

procedure TProjectForm.ModifyItemClick;
begin
  if not (IsReadOnly or DataBaseView.IsEditing)
    then ModifyCurItem;
end;

procedure TProjectForm.CutToClipboardClick;
begin
  if not (IsReadOnly or DataBaseView.IsEditing)
    then begin
           CopyToClipboard(DataBaseView.Selected);
           DeleteCurItem;
         end;
end;

procedure TProjectForm.CopyToClipboardClick;
begin
  CopyToClipboard(DataBaseView.Selected);
end;

procedure TProjectForm.PasteFromClipboardClick;
begin
  if not (IsReadOnly or DataBaseView.IsEditing)
    then begin
           InsertFromClipboard(DataBaseView.Selected);
           ItemViewUpdate;
         end;
end;

procedure TProjectForm.DeleteItemClick;
begin
  if not (IsReadOnly or DataBaseView.IsEditing)
    then DeleteCurItem;
end;

procedure TProjectForm.RenameItemClick;
begin
  if not IsReadOnly
    then DataBaseView.Selected.EditText;
end;

procedure TProjectForm.FindItemClick;
begin
  FindDlg.Execute;
end;

procedure TProjectForm.CopyToClipboard(Node: TTreeNode);
var
  Clipboard: TClipboard;
begin
  Clipboard:=TClipboard.Create;
  try
    Clipboard.SetTextBuf(PChar(TreeToText(Node)));
  finally
    Clipboard.Free;
  end;
end;

procedure TProjectForm.InsertFromClipboard(Node: TTreeNode);
var
  Clipboard: TClipboard;
begin
  Clipboard:=TClipboard.Create;
  try
    InsertTreeFromText(Node,Clipboard.AsText);
  finally
    Clipboard.Free;
  end;
  SetModified;
end;

procedure TProjectForm.EndEditing(Sender: TObject; Node: TTreeNode;
                                  var S: string);
begin
  if (Length(S)>0) and (S[1]<>' ') and (S[1]<>'/')
    then begin
           Node.Text:=S;
           SetModified;
           StatusBarUpdate;
         end
    else S:=Node.Text;
end;

procedure TProjectForm.SelectorChanged(Sender: TObject; Node: TTreeNode);
begin
  StatusBarUpdate;
  ItemViewUpdate;
end;

end.