Unit SaveAndRestore;

{ This unit is repsonsible for saving and restoring the position and settings
  of the various windows.

  All saved files contain one component, and any number of subcomponents.
  We only save TComponent objects to take advantage of the libraries that
  exist for saving complicated objects like fonts.  We always save exactly
  one of these objects because it is easiest to create and display a text
  version of the file that way.

  The components that we save cannot be arranged in just any tree format.
  Their should be one master component, and all other components should
  reference that component as their owner.  If we try to make the tree any
  deeper, the file appears to save correctly, but it does not load correctly.
  Specifically, any property that is a component, but is not owned by the
  top level component, is set to nil.  This appears to be a bug in Delphi.
  The component is created, but properties that should point to the component,
  don't.  We could manually find these components, but it's easier just to
  use the arrangement described here.

  We always save and load binary files.  We can create a text version of the
  file for debugging, but we don't read it back in.  This is the default
  way the libraries work, and we don't really want to encourage people to
  manually modify the files anyway.

  This unit is not thread safe and should only be accessed from the GUI thread.
}

Interface

  Uses
    Classes, ActnList, Controls, Forms;

  Type
    { We usually save and restore components of type TWindowFactory.  We save
      factories, rather than the original objects, because it is hard to
      restore the actual objects.  When we try to restore a form, for example,
      we get two copies of all of the subcomponents, one created by the
      constructor, and one restored from the streaming system.  We have similar
      problems with other objects.

      This base class also gives us a standard way to deal with the data
      after we read it from the file.  We always call CreateWindow on the
      saved component.  Normally this will create a window, but it can do
      anything.  That allows us to save more complicated types of state;
      no matter what we save, we include a pointer to an appropriate procedure
      for processing it.

      This should be the base class for all top level components that we
      save.  But it was also made to be a convenient class for subcomponents.
    }
    TWindowFactory =
      Class(TComponent)
      Public
        { We call this after we load the entire component from the stream.  If
          we are loading a window (the paradigm) the window should initially
          be invisible.  This allows us to move the window without a flash on
          the screen.  The return value should be the window.  If this class
          does not represent a window, CreateWindow should return Nil. }
        Function CreateWindow(AOwner : TObject) : TObject; Virtual; Abstract;

        { This is a common way to use CreateWindow.  We ignore Nil items.  We
          make the control visible.  By default we leave the position alone.
          But, if the control is a form, and the user requests it, we can
          offset the form slightly.  This is only intended for forms. }
        Procedure CreateVisibleWindow(ExactPosition : Boolean = True);

        { This was overriden to make the streaming system work.  It tells the
          streaming system to save all compoents that have this compoent as
          their owner.  This should no be called directly. }
        Procedure GetChildren(Proc: TGetChildProc; Root: TComponent); Override;

        { This sets the name of the component to an arbitrary, unique name,
          unless the component already has a name.  The streaming system
          does not work well if a component does not have a name. }
        Procedure AfterConstruction; Override;
      Protected

        { This allows us to find the root of the tree.  If this component
          uses other components, those components should have AppropriateOwner
          as their owner.  The need for this is described in the overview
          of this unit. }
        Function AppropriateOwner : TComponent;
      End;

    TFormFactory =
      Class(TWindowFactory)
      Private
        FLeft, FTop, FHeight, FWidth : Integer;
        FWindowName : String;
        FWindowState: TWindowState;
        FTopLevel : Boolean;
      Protected
        Procedure FormToFactory(Form : TForm);
        Procedure FactoryToForm(Form : TForm); Virtual;
      Public
      Published
        Property Left : Integer Read FLeft Write FLeft Stored FTopLevel;
        Property Top : Integer Read FTop Write FTop Stored FTopLevel;
        Property Height : Integer Read FHeight Write FHeight;
        Property Width : Integer Read FWidth Write FWidth;
        Property WindowName : String Read FWindowName Write FWindowName;
        Property WindowState : TWindowState Read FWindowState Write FWindowState Default wsNormal;
      End;

    { ISavable represents objects that know how to save themselves.  When you
      save the layout, the software looks for all top level windows that know
      how to save themselves, and saves them.  Before restoring a layout,
      the software first destroys all savable windows, then replaces them
      with the windows that were previously saved. }
    ISavable =
      Interface(IUnknown)
      ['{81D17EED-A1B9-48B7-B079-40548F6FDC1B}']
        { We only save top level windows.  Subwindows, such as docked windows,
          are the responsibility of the parent window. }
        Function IsTopLevelWindow : Boolean;

        { Instructions for saving the window.  The factory will be freed as
          soon as the user is done with it, so always produce a new object.
          The owner of the factory should be AOwner. }
        Function GetWindowFactory(AOwner : TComponent = Nil) : TWindowFactory;
      End;

    { This saves the entire top level window that owns the action. }
    TSaveAction =
      Class(TAction)
      Private
        Procedure DoSave(Sender : TObject);
      Public
        { The owner must be a TControl.  That control is where we start looking
          for a top level window. }
        Constructor Create(AOwner: TComponent); Override;
      End;

    { This duplicates a window.  It uses the same factories and interfaces
      as save and restore do.  So any window that knows how to save itself
      can be duplicated. }
    TDuplicateAction =
      Class(TAction)
      Private
        FPanelOnly : Boolean;
        Procedure DoDuplicate(Sender : TObject);
        Procedure DoUpdate(Sender : TObject);
        Function GetPanel : ISavable;
        Function GetWindow : ISavable;
        Function GetTarget : ISavable;
      Protected
        Procedure SetPanelOnly(P : Boolean);
      Public
        { Owner is where we start looking for the window to save. Owner
          should be a TControl. }
        Constructor Create(AOwner : TComponent); Override;

        { If PanelOnly is true, then we save the ISavable closest to the
          owner of this action.  Presumably that is a panel.  If PanelOnly
          is false we go up to the top level window, or to the ISavable closest
          to the top level window.  If we only find one ISavable between this
          actin and the top level window, call that ISavable the panel, and
          we say that there is no top level window.  We automatically update
          the caption and we automatically enable or disable this action
          based on this property.  We also update these every time the
          user docks or undocks the panel that ownes this action. }
        Property PanelOnly : Boolean Read FPanelOnly Write SetPanelOnly;
      End;

    { This is a linked list for holding components.  Delphi has a component
      list class, but it is hard to use.  It must be customized for each
      type of component you want to add.  This list does not care.  This was
      only created for use in factories, and is not as efficient as other ways
      to store a list of components.  But, in a factory, this is pretty easy to
      use. }
    TComponentList =
      Class(TComponent)
      Private
        FFirst : TComponent;
        FRest : TComponentList;
      Public

        { This is the simple way to create a list.  Start with a variable which
          is Nil, for the empty list.  The push new components onto the list
          with this procedure.  The new linked list node will use the owner
          of Component as its own owner.  So Component cannot be Nil. }
        Class Procedure Push(Component : TComponent; Var List : TComponentList);
      Published

        { The current list item. }
        Property First : TComponent Read FFirst Write FFirst;

        { The remaining list items. }
        Property Rest : TComponentList Read FRest Write FRest;
      End;

  { Save the component to a file. }
  Procedure SaveComponent(Factory : TWindowFactory; Const FileName : String); Overload;

  { Get the factory, and save that to the a file. }
  Procedure SaveComponent(Component : ISavable; Const FileName : String = ''); Overload;

  { This loads a factory from a file, then calls CreateWindow.  The resulting
    window is returned.  The factory is automatically freed. }
  Function RestoreComponent(Const FileName : String = '') : TObject;

  Procedure RestoreVisibleWindow(Const FileName : String = ''; ExactPosition : Boolean = True);

  { This saves the entire layout, including the state of all top level windows
    which implement ISavable.  This also includes the stock symbols which
    are stored in the group list.  Call RestoreComponet on the file to restore
    the entire layout.  It will not return a meaningful value. }
  Procedure SaveLayout(Const FileName : String = '');

  { This creates a unique identifier.  It is useful when naming components.
    All components require a name or you cannot save and restore them.  Because
    of the flattened tree strucuture that we use, we need a global function
    to assign unique names to the components. }
  Function GenSym : String;

Implementation

  Uses
    Groups,
    SysUtils, Dialogs;

  Procedure SaveComponent(Component : ISavable; Const FileName : String);
    Var
      Factory : TWindowFactory;
    Begin
      Factory := Component.GetWindowFactory;
      Try
        SaveComponent(Factory, FileName)
      Finally
        Factory.Free
      End
    End;

  Procedure SaveComponent(Factory : TWindowFactory; Const FileName : String);
    Var
      BinStream, TextStream : TStream;
    Begin
      BinStream := TFileStream.Create(FileName, fmCreate);
      Try
        BinStream.WriteComponent(Factory);
        BinStream.Position := 0;
        TextStream := TFileStream.Create(FileName + '.txt', fmCreate);
        Try
          ObjectBinaryToText(BinStream, TextStream)
        Finally
          TextStream.Free
        End
      Finally
        BinStream.Free
      End
    End;

  Var
    ReadingFromStream : Boolean;

  Var
    NextGenSym : Integer;

  Function GenSym : String;
    Begin
      Result := Format('Anonymous_%d', [NextGenSym]);
      Inc(NextGenSym);
    End;

  ////////////////////////////////////////////////////////////////////////
  // Load File
  ////////////////////////////////////////////////////////////////////////

  Var OpenDialog : TOpenDialog;

  Function GetOpenDialog : TOpenDialog;
    Begin
      If Not Assigned(OpenDialog) Then
        Begin
          OpenDialog := TOpenDialog.Create(Application);
          OpenDialog.Filter := 'Windows (*.PWn)|*.PWn|Layouts (*.PLy)|*.PLy|All Files (*.*)|*.*';
          OpenDialog.DefaultExt := 'PWn';
          OpenDialog.Options := OpenDialog.Options + [ofFileMustExist, ofPathMustExist];
        End;
      Result := OpenDialog;
    End;

  Function RestoreFactory(Const FileName : String) : TWindowFactory;
    Var
      RealFileName : String;
      Stream : TStream;
      C : TComponent;
    Begin
      RealFileName := FileName;
      If RealFileName = '' Then
        Begin
          If GetOpenDialog.Execute Then
            RealFileName := GetOpenDialog.FileName;
        End;
      If RealFileName <> '' Then
        Begin
          Stream := TFileStream.Create(RealFileName, fmOpenRead);
          Try
            Try
              ReadingFromStream := True;
              C := Stream.ReadComponent(Nil)
            Finally
              ReadingFromStream := False
            End;
            Try
              Result := C As TWindowFactory;
              C := Nil
            Finally
              // If the conversion failed, we free the data before the
              // exception gets out.  If the conversion succeeded, nothing
              // happens.
              C.Free
            End;
          Finally
            Stream.Free
          End
        End
      Else
        Result := Nil
    End;

  Procedure RestoreVisibleWindow(Const FileName : String; ExactPosition : Boolean);
    Var
      Factory : TWindowFactory;
    Begin
      Factory := RestoreFactory(FileName);
      If Assigned(Factory) Then
        Try
          Factory.CreateVisibleWindow(ExactPosition)
        Finally
          Factory.Free
        End
    End;

  Function RestoreComponent(Const FileName : String) : TObject;
    Var
      Factory : TWindowFactory;
    Begin
      Factory := RestoreFactory(FileName);
      Try
        Result := Factory.CreateWindow(Nil)
      Finally
        Factory.Free
      End
    End;

  ////////////////////////////////////////////////////////////////////////
  // TMainWindowLayout
  ////////////////////////////////////////////////////////////////////////

  Type
    TMainWindowLayout =
      Class(TFormFactory)
      Public
        Function CreateWindow(AOwner : TObject) : TObject; Override;
        Class Function Get(AOwner : TComponent) : TMainWindowLayout;
      End;

    Function TMainWindowLayout.CreateWindow(AOwner : TObject) : TObject;
      Begin
        FactoryToForm(Application.MainForm);
        Result := Application.MainForm
      End;

    Class Function TMainWindowLayout.Get(AOwner : TComponent) : TMainWindowLayout;
      Begin
        Result := Create(AOwner);
        Result.FormToFactory(Application.MainForm)
      End;

  ////////////////////////////////////////////////////////////////////////
  // TLayout
  ////////////////////////////////////////////////////////////////////////

  Type
    TLayout =
      Class(TWindowFactory)
      Private
        FWindowList : TComponentList;
        FGroupNames, FStockNames : TStrings;
      Public
        Constructor Create(AOwner : TComponent); Override;
        Destructor Destroy; Override;
        Function CreateWindow(AOwner : TObject) : TObject; Override;
        Procedure Load;
      Published
        Property WindowList : TComponentList Read FWindowList Write FWindowList;
        Property GroupNames : TStrings Read FGroupNames Write FGroupNames;
        Property StockNames : TStrings Read FStockNames Write FStockNames;
      End;

  Constructor TLayout.Create(AOwner : TComponent);
    Begin
      Inherited;
      FGroupNames := TStringList.Create;
      FStockNames := TStringList.Create;
    End;

  Destructor TLayout.Destroy;
    Begin
      FGroupNames.Free;
      FStockNames.Free;
      Inherited;
    End;

  Procedure TLayout.Load;
    Var
      Original : ISavable;
      I : Integer;
    Begin
      FGroupNames.Assign(TGroupList.Instance.GroupNames);
      FStockNames.Clear;
      For I := 0 To Pred(FGroupNames.Count) Do
        FStockNames.Add(TGroupList.Instance.GetSymbol(FGroupNames.Strings[I]));
      For I := 0 To Pred(Screen.CustomFormCount) Do
        If Supports(Screen.CustomForms[I], ISavable) Then
          Begin
            Original := Screen.CustomForms[I] As ISavable;
            If Original.IsTopLevelWindow Then
              TComponentList.Push(Original.GetWindowFactory(AppropriateOwner), FWindowList)
          End;
      TComponentList.Push(TMainWindowLayout.Get(AppropriateOwner), FWindowList)
    End;

  Function TLayout.CreateWindow(AOwner : TObject) : TObject;
    Procedure CloseOldWindows;
      Var
        Done : Boolean;
        Window : ISavable;
        I : Integer;
      Begin
        Repeat
          Done := True;
          For I := 0 To Pred(Screen.CustomFormCount) Do
            Begin
              If Supports(Screen.CustomForms[I], ISavable) Then
                Begin
                  Window := Screen.CustomForms[I] As ISavable;
                  If Window.IsTopLevelWindow Then
                    Begin
                      Done := False;
                      Window := Nil;  // Otherwise there is an implicit call to
                                      // lower the reference count of the window
                                      // after we free it.
                      Screen.CustomForms[I].Free;
                      Break
                    End
                End
            End
        Until Done
      End;

    Procedure CreateNewWindows;
      Var
        Remaining : TComponentList;
      Begin
        Remaining := FWindowList;
        While Assigned(Remaining) Do
          Begin
            (Remaining.First As TWindowFactory).CreateVisibleWindow;
            Remaining := Remaining.Rest
          End
      End;

    Procedure SetSymbols;
      Var
        I : Integer;
      Begin
        For I := 0 To Pred(FGroupNames.Count) Do
          TGroupList.Instance.SetSymbol(FGroupNames.Strings[I], FStockNames.Strings[I])
      End;

    Begin
      CloseOldWindows;
      CreateNewWindows;
      SetSymbols;
      Result := Nil
    End;

  Var SaveLayoutDialog : TSaveDialog;

  Function GetSaveLayoutDialog : TSaveDialog;
    Begin
      If Not Assigned(SaveLayoutDialog) Then
        Begin
          SaveLayoutDialog := TSaveDialog.Create(Application);
          SaveLayoutDialog.Filter := 'Layouts (*.PLy)|*.PLy|All Files (*.*)|*.*';
          SaveLayoutDialog.DefaultExt := 'PLy';
          SaveLayoutDialog.Options := SaveLayoutDialog.Options + [ofOverwritePrompt, ofPathMustExist, ofNoReadOnlyReturn];
        End;
      Result := SaveLayoutDialog;
    End;

  Procedure SaveLayout(Const FileName : String);
    Var
      Layout : TLayout;
      RealFileName : String;
    Begin
      RealFileName := FileName;
      If RealFileName = '' Then
        Begin
          If GetSaveLayoutDialog.Execute Then
            RealFileName := GetSaveLayoutDialog.FileName;
        End;
      If RealFileName <> '' Then
        Begin
          Layout := TLayout.Create(Nil);
          Try
            Layout.Load;
            SaveComponent(Layout, RealFileName)
          Finally
            Layout.Free
          End
        End
    End;

  ////////////////////////////////////////////////////////////////////////
  // TSaveAction
  ////////////////////////////////////////////////////////////////////////

  Var SaveWindowDialog : TSaveDialog;

  Function GetSaveWindowDialog : TSaveDialog;
    Begin
      If Not Assigned(SaveWindowDialog) Then
        Begin
          SaveWindowDialog := TSaveDialog.Create(Application);
          SaveWindowDialog.Filter := 'Windows (*.PWn)|*.PWn|All Files (*.*)|*.*';
          SaveWindowDialog.DefaultExt := 'PWn';
          SaveWindowDialog.Options := SaveWindowDialog.Options + [ofOverwritePrompt, ofPathMustExist, ofNoReadOnlyReturn];
        End;
      Result := SaveWindowDialog;
    End;

  Procedure TSaveAction.DoSave(Sender : TObject);
    Var
      Next : TControl;
    Begin
      If GetSaveWindowDialog.Execute Then
        Begin
          Next := Owner As TControl;
          While Assigned(Next.Parent) Do
            Next := Next.Parent;
          SaveComponent(Next As ISavable, GetSaveWindowDialog.FileName)
        End
    End;

  Constructor TSaveAction.Create(AOwner: TComponent);
    Begin
      Inherited;
      Caption := 'Save...';
      OnExecute := DoSave
    End;

  ////////////////////////////////////////////////////////////////////////
  // TDuplicateAction
  ////////////////////////////////////////////////////////////////////////

  Procedure TDuplicateAction.DoDuplicate(Sender : TObject);
    Var
      Original : ISavable;
      Factory : TWindowFactory;
    Begin
      Original := GetTarget;
      If Assigned(Original) Then
        Begin
          Factory := Original.GetWindowFactory;
          If Assigned(Factory) Then
            Try
              Factory.CreateVisibleWindow(False)
            Finally
              Factory.Free
            End
        End
    End;

  Function TDuplicateAction.GetPanel : ISavable;
    Var
      Next : TControl;
    Begin
      Result := Nil;
      Next := Owner As TControl;
      While Assigned(Next) And Not Assigned(Result) Do
        Begin
          If Supports(Next, ISavable) Then
            Result := Next As ISavable;
          Next := Next.Parent
        End
    End;

  Function TDuplicateAction.GetWindow : ISavable;
    Var
      Next : TControl;
      OneFound : Boolean;
    Begin
      OneFound := False;
      Result := Nil;
      Next := Owner As TControl;
      While Assigned(Next) Do
        Begin
          If Supports(Next, ISavable) Then
            If OneFound Then
              Result := Next As ISavable
            Else
              OneFound := True;
          Next := Next.Parent
        End
    End;

  Function TDuplicateAction.GetTarget : ISavable;
    Begin
      If FPanelOnly Then
        Result := GetPanel
      Else
        Result := GetWindow
    End;

  Procedure TDuplicateAction.DoUpdate(Sender : TObject);
    Begin
      If FPanelOnly Then
        Caption := 'Duplicate Panel'
      Else
        Caption := 'Duplicate Window';
      Enabled := GetTarget <> Nil
    End;

  Procedure TDuplicateAction.SetPanelOnly(P : Boolean);
    Begin
      FPanelOnly := P;
    End;

  Constructor TDuplicateAction.Create(AOwner : TComponent);
    Begin
      Inherited;
      OnExecute := DoDuplicate;
      OnUpdate := DoUpdate
    End;

  ////////////////////////////////////////////////////////////////////////
  // TWindowFactory
  ////////////////////////////////////////////////////////////////////////

  Procedure TWindowFactory.CreateVisibleWindow(ExactPosition : Boolean = True);
    Var
      Control : TObject;
    Begin
      Control := CreateWindow(Nil);
      If Assigned(Control) Then
        Begin
          If (Not ExactPosition) And (Control Is TForm) Then
            Begin
              // The form only looks for changes.  If the form was created
              // as poDefaultPosOnly, then we set the top and left, the form
              // uses the top and left.  If we try to set the Position to
              // poDefaultPosOnly again, the form ignores it because that
              // is already the position.  But this sequence causes the
              // form to use the position, not the top and left.
              (Control As TForm).Position := poDefaultSizeOnly;
              (Control As TForm).Position := poDefaultPosOnly
            End;
          If Control Is TControl Then
            (Control As TControl).Visible := True
        End
    End;

  Procedure TWindowFactory.GetChildren(Proc: TGetChildProc; Root: TComponent);
    Var
      I : Integer;
    Begin
      For I := 0 To Pred(ComponentCount) Do
        Proc(Components[I])
    End;

  Procedure TWindowFactory.AfterConstruction;
    Begin
      Inherited;
      If (Not ReadingFromStream) And (Name = '') Then
        Name := GenSym
    End;

  Function TWindowFactory.AppropriateOwner : TComponent;
    Begin
      If Owner = Nil Then
        Result := Self
      Else
        Result := Owner
    End;

  ////////////////////////////////////////////////////////////////////////
  // TFormFactory
  ////////////////////////////////////////////////////////////////////////

  Procedure TFormFactory.FormToFactory(Form : TForm);
    Begin
      FTopLevel := Form.Parent = Nil;
      Left := Form.Left;
      Top := Form.Top;
      If FTopLevel Then
        Begin
          Height := Form.Height;
          Width := Form.Width
        End
      Else
        Begin
          // Forms are always created in the undocked state, even if they
          // are redocked soon after.
          Height := Form.UndockHeight;
          Width := Form.UndockWidth
        End;
      WindowName := Form.Name;
      WindowState := Form.WindowState
    End;

  Procedure TFormFactory.FactoryToForm(Form : TForm);
    Begin
      Form.Left := Left;
      Form.Top := Top;
      Form.Height := Height;
      Form.Width := Width;
      Form.Name := WindowName;
      Form.WindowState := WindowState
    End;

  ////////////////////////////////////////////////////////////////////////
  // TComponentList
  ////////////////////////////////////////////////////////////////////////

  Class Procedure TComponentList.Push(Component : TComponent; Var List : TComponentList);
    Var
      NewNode : TComponentList;
    Begin
      NewNode := TComponentList.Create(Component.Owner);
      NewNode.First := Component;
      NewNode.Rest := List;
      NewNode.Name := GenSym;
      List := NewNode
    End;

  ////////////////////////////////////////////////////////////////////////
  // Initialization
  ////////////////////////////////////////////////////////////////////////

Initialization
  RegisterClass(TComponentList);
  RegisterClass(TLayout);
  RegisterClass(TMainWindowLayout);

End.