Unit mandocking;

{$MODE objfpc}{$H+}

Interface

Uses
  Types,
  Forms,
  SysUtils,
  Controls,
  ExtCtrls,
  ProjectIntf,
  LazIDEIntf,
  MenuIntf,
  IDEMsgIntf,
  SrcEditorIntf,
  XMLConf;

Procedure Register;

Resourcestring
  mnuDockMsgWindow = 'Dock "Messages" window';

Implementation

Type
  TDockState = Record
    Docked: Boolean;
    FloatRect: TRect;
    FloatBrd: TFormBorderStyle;
    DockSize: TSize;
  End;

  { TManualDocker }

  TManualDocker = Class(TObject)
  private
    FCurrentSrcWin: TWinControl;
    isdocked: Boolean;
  protected
    Function DoChangeDocking(DockingEnabled: Boolean): Boolean;
    Procedure LoadState(cfg: TXMLConfig; Var Astate: TDockState; Const StateName: String);
    Procedure SaveState(cfg: TXMLConfig; Const Astate: TDockState; Const StateName: String);
    Procedure LoadStates;
    Procedure SaveStates;

    Procedure AllocControls(AParent: TWinControl);
    Procedure DeallocControls;
    Procedure RealignControls;
    Procedure UpdateDockState(Var astate: TDockState; wnd: TWinControl);

    Procedure SourceWindowCreated(Sender: TObject);
    Procedure SourceWindowDestroyed(Sender: TObject);
  public
    ConfigPath: AnsiString;
    split: TSplitter;
    panel: TPanel;
    MsgWnd: TDockState;
    Constructor Create;
    Destructor Destroy; override;
    Procedure OnCmdClick(Sender: TObject);
    Function OnProjectOpen(Sender: TObject; AProject: TLazProject): TModalResult;
  End;

Var
  cmd: TIDEMenuCommand = Nil;
  docker: TManualDocker = Nil;

Const
  DockCfgRoot = 'ManualDockConfig';
  DockCfgXML = 'manualdockconfig.xml';
  MsgDockedName = 'Messages';

  { TManualDocker }

Function SafeRect(Const c: TREct; MinWidth, MinHeight: Integer): TRect;
Begin
  Result := c;
  If Result.Top < 0 Then Result.Top := 0;
  If Result.Left < 0 Then Result.Left := 0;
  If c.Right - c.Left < MinWidth Then Result.Right := Result.Left + MinWidth;
  If c.Bottom - c.Top < MinHeight Then Result.Bottom := Result.Top + MinHeight;
End;

Function Max(a, b: Integer): Integer;
Begin
  If a > b Then
    Result := a
  Else
    Result := b;
End;

Function TManualDocker.DoChangeDocking(DockingEnabled: Boolean): Boolean;
Var
  i: Integer;
Begin
  If DockingEnabled Then Begin
    If isdocked Then Begin
      result := true;
      exit;
    End;
    isdocked := true;
    Result := False;
    If Not (Assigned(SourceEditorManagerIntf) And Assigned(SourceEditorManagerIntf.ActiveSourceWindow))
      Or Not Assigned(IDEMessagesWindow)
      Then Exit;

    If Not Assigned(panel) Then
      AllocControls(SourceEditorManagerIntf.ActiveSourceWindow);

    If panel.Parent <> SourceEditorManagerIntf.ActiveSourceWindow Then Begin
      split.Parent := SourceEditorManagerIntf.ActiveSourceWindow;
      panel.Parent := SourceEditorManagerIntf.ActiveSourceWindow;
    End;

    split.visible := true;
    panel.visible := true;
    With IDEMessagesWindow Do
      If IDEMessagesWindow.Parent = Nil Then Begin
        MsgWnd.FloatRect := Bounds(Left, Top, Width, Height);
        MsgWnd.FloatBrd := IDEMessagesWindow.BorderStyle;
      End;
    IDEMessagesWindow.Parent := panel;
    IDEMessagesWindow.Align := alClient;
    IDEMessagesWindow.BorderStyle := bsNone;
    IDEMessagesWindow.TabStop := False;
    For i := 0 To IDEMessagesWindow.ControlCount - 1 Do
      If IDEMessagesWindow.Controls[i] Is TWinControl Then
        TWinControl(IDEMessagesWindow.Controls[i]).TabStop := False;
    panel.Height := MsgWnd.DockSize.cy;
    Result := True;
  End
  Else Begin
    If Assigned(panel) Then Begin
      panel.visible := False;
      UpdateDockState(MsgWnd, panel);
    End;
    If Assigned(split) Then split.visible := False;
    IDEMessagesWindow.Parent := Nil;
    With MsgWnd Do Begin
      IDEMessagesWindow.BoundsRect := SafeRect(FloatRect,
        Max(30, IDEMessagesWindow.ClientWidth), Max(30, IDEMessagesWindow.ClientHeight));
      IDEMessagesWindow.BorderStyle := FloatBrd;
    End;
    IDEMessagesWindow.TabStop := true;
    IDEMessagesWindow.Show;

    {undocking is always succesfull}
    Result := True;
  End;
End;

Constructor TManualDocker.Create;
Var
  pths: Array[0..1] Of String;
  i: Integer;
Begin
  isdocked := false;
  If SourceEditorManagerIntf <> Nil Then Begin
    SourceEditorManagerIntf.RegisterChangeEvent(semWindowCreate, @SourceWindowCreated);
    SourceEditorManagerIntf.RegisterChangeEvent(semWindowDestroy, @SourceWindowDestroyed);
  End;

  pths[0] := LazarusIDE.GetPrimaryConfigPath;
  pths[1] := LazarusIDE.GetSecondaryConfigPath;
  For i := 0 To length(pths) - 1 Do Begin
    Try
      ConfigPath := IncludeTrailingPathDelimiter(pths[i]) + DockCfgXML;
      LoadStates;
      Break;
    Except
    End;
  End;
  MsgWnd.FloatBrd := bsToolWindow;
End;

Destructor TManualDocker.Destroy;
Begin
  If Assigned(panel) Then UpdateDockState(MsgWnd, panel);
  SaveStates;
  DeallocControls;
  Inherited Destroy;
End;

Procedure TManualDocker.OnCmdClick(Sender: TObject);
Var
  NeedDocking: Boolean;
Begin
  NeedDocking := Not Cmd.Checked;
  DoChangeDocking(NeedDocking);
  MsgWnd.docked := NeedDocking;
  cmd.Checked := NeedDocking;
End;

Function TManualDocker.OnProjectOpen(Sender: TObject; AProject: TLazProject): TModalResult;
Begin
  isdocked := false;
  DoChangeDocking(MsgWnd.Docked);
  Result := mrOK;
End;

Function CreateXMLConfig(Const xmlfile: String): TXMLConfig;
Begin
  Result := TXMLConfig.Create(Nil);
  Result.RootName := DockCfgRoot;
  Result.Filename := xmlfile;
End;

Procedure TManualDocker.AllocControls(AParent: TWinControl);
Begin
  FCurrentSrcWin := AParent;
  panel := TPanel.Create(AParent);
  panel.Parent := AParent;
  panel.BorderStyle := bsNone;

  split := TSplitter.Create(AParent);
  split.Parent := AParent;

  RealignControls;
End;

Procedure TManualDocker.DeallocControls;
Begin
  split := Nil;
  panel := Nil;
End;

Procedure TManualDocker.RealignControls;
Begin
  panel.Align := alClient;
  split.Align := alClient;
  panel.Align := alBottom;
  split.Align := alBottom;
End;

Procedure TManualDocker.UpdateDockState(Var astate: TDockState; wnd: TWinControl);
Begin
  astate.DockSize.cx := wnd.ClientWidth;
  astate.DockSize.cy := wnd.ClientHeight;
End;

Procedure TManualDocker.SourceWindowCreated(Sender: TObject);
Begin
  If Assigned(FCurrentSrcWin) Or (SourceEditorManagerIntf.SourceWindowCount > 1) Then
    Exit;
  If MsgWnd.Docked Then DoChangeDocking(true);
End;

Procedure TManualDocker.SourceWindowDestroyed(Sender: TObject);
Var
  i: Integer;
Begin
  If FCurrentSrcWin <> Sender Then Exit;
  DoChangeDocking(False);
  DeallocControls;
  FCurrentSrcWin := Nil;

  // avoid re-docking to the window being destroyed
  If MsgWnd.Docked And (SourceEditorManagerIntf.ActiveSourceWindow <> Sender) Then
    DoChangeDocking(True);
End;

Procedure TManualDocker.LoadState(cfg: TXMLConfig; Var Astate: TDockState;
  Const StateName: String);
Begin
  AState.Docked := cfg.GetValue(StateName + '/docked', False);
  AState.FloatRect.Left := cfg.GetValue(StateName + '/float/left', -1);
  AState.FloatRect.Top := cfg.GetValue(StateName + '/float/top', -1);
  AState.FloatRect.Right := cfg.GetValue(StateName + '/float/right', -1);
  AState.FloatRect.Bottom := cfg.GetValue(StateName + '/float/bottom', -1);
  AState.DockSize.cx := cfg.GetValue(StateName + '/docked/cx', 30);
  AState.DockSize.cy := cfg.GetValue(StateName + '/docked/cy', 50);
End;

Procedure TManualDocker.SaveState(cfg: TXMLConfig; Const Astate: TDockState; Const StateName: String);
Begin
  cfg.SetValue(StateName + '/docked', AState.Docked);
  cfg.SetValue(StateName + '/float/left', AState.FloatRect.Left);
  cfg.SetValue(StateName + '/float/top', AState.FloatRect.Top);
  cfg.SetValue(StateName + '/float/right', AState.FloatRect.Right);
  cfg.SetValue(StateName + '/float/bottom', AState.FloatRect.Bottom);
  cfg.SetValue(StateName + '/docked/cx', AState.DockSize.cx);
  cfg.SetValue(StateName + '/docked/cy', AState.DockSize.cy)
End;

Procedure TManualDocker.LoadStates;
Var
  cfg: TXMLConfig;
Begin
  cfg := CreateXMLConfig(ConfigPath);
  Try
    LoadState(cfg, MsgWnd, MsgDockedName)
  Finally
    cfg.Free;
  End;
End;

Procedure TManualDocker.SaveStates;
Var
  cfg: TXMLConfig;
Begin
  cfg := CreateXMLConfig(ConfigPath);
  Try
    Try
      SaveState(cfg, MsgWnd, MsgDockedName)
    Finally
      cfg.Free;
    End;
  Except
  End;
End;

Procedure Register;
Begin
  docker := TManualDocker.Create;
  cmd := RegisterIDEMenuCommand(itmViewMainWindows, 'makeMessagesDocked', mnuDockMsgWindow, @docker.OnCmdClick, Nil, Nil, '');
  LazarusIDE.AddHandlerOnProjectOpened(@docker.OnProjectOpen, False);
End;

Initialization

Finalization
  docker.Free;

End.