manual docker added

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@708 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/manualdock/mandocking.pas

@@ -0,0 +1,254 @@
+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)
+  protected
+    procedure ChangeDocking(DockingEnabled: 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 RealignControls;
+    procedure UpdateDockState(var astate: TDockState; wnd: TWinControl);
+  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;
+
+procedure TManualDocker.ChangeDocking(DockingEnabled: Boolean);
+begin
+  if DockingEnabled then begin
+    if not Assigned(SourceEditorWindow) or not Assigned(IDEMessagesWindow) then Exit;
+    if not Assigned(panel) then AllocControls(SourceEditorWindow);
+    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;
+    panel.Height := MsgWnd.DockSize.cy;
+  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;
+  end;
+  MsgWnd.docked := DockingEnabled;
+  cmd.Checked := DockingEnabled;
+end;
+
+constructor TManualDocker.Create;
+var
+  pths  : array [0..1] of String;
+  i     : Integer;
+begin
+  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;
+  split.Free;
+  panel.Free;
+  inherited Destroy;
+end;
+
+procedure TManualDocker.OnCmdClick(Sender: TObject);
+begin
+  ChangeDocking(not Cmd.Checked );
+end;
+
+function TManualDocker.OnProjectOpen(Sender: TObject; AProject: TLazProject): TModalResult;
+begin
+  if MsgWnd.Docked then ChangeDocking(true);
+  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
+  panel := TPanel.Create(nil);
+  panel.Parent := AParent;
+  panel.BorderStyle := bsNone;
+
+  split := TSplitter.Create(nil);
+  split.Parent := AParent;
+
+  RealignControls;
+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.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.
+

components/manualdock/manualdock.lpk

@@ -0,0 +1,45 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="3">
+    <Name Value="manualdock"/>
+    <Author Value="Dmitry 'skalogryz' Boyarintsev"/>
+    <CompilerOptions>
+      <Version Value="8"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/"/>
+      </SearchPaths>
+      <Other>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Description Value="The extensions adds an ability to dock Messages window to the source editor	"/>
+    <Version Major="1"/>
+    <Files Count="1">
+      <Item1>
+        <Filename Value="mandocking.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="mandocking"/>
+      </Item1>
+    </Files>
+    <Type Value="RunAndDesignTime"/>
+    <RequiredPkgs Count="3">
+      <Item1>
+        <PackageName Value="IDEIntf"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item3>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)/"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

components/manualdock/manualdock.pas

@@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit manualdock; 
+
+interface
+
+uses
+  mandocking, LazarusPackageIntf;
+
+implementation
+
+procedure Register; 
+begin
+  RegisterUnit('mandocking', @mandocking.Register); 
+end; 
+
+initialization
+  RegisterPackage('manualdock', @Register); 
+end.

components/manualdock/readme.txt

@@ -0,0 +1,33 @@
+Copyright (c) 2009 Dmitry Boyarintsev
+You're free to use these sources in anyway you find useful.
+
+= Manual Docker =
+
+There's been a lot of patches and wishes for Messages window to be docked 
+at the source editor of Lazarus IDE. All patches were eventually rejected, 
+because Messages window must be dockable by using Docking manager, that's 
+not yet fully implemented for all widgetset. 
+
+Keeping Messages window floating might be very annoying for some people, 
+especially coming from Delphi. 
+
+
+This IDE extension allows Messages window to dock to the source editor. 
+
+
+== Installation ==
+
+Download the extension sources. 
+Copy the extensions source directory to Lazarus/Components directory. 
+Start Lazarus IDE (if not started) 
+Open installed packages manager Package->Configure installed packages... 
+Select "manualdock 1.0" from "Available packages list" 
+Press "Save and rebuild IDE". 
+[edit]
+
+== How-to Use ==
+
+After Lazarus IDE is rebuilt with the extension, you should see 
+an additional menu item at View menu, named "Dock Messages window". 
+
+Selecting this menu item will dock/undock messages window from the source editor.