IDE now extends/clean up project unit path on renaming a project unit

git-svn-id: trunk@8168 -

.gitattributes

@@ -1931,6 +1931,10 @@ lcl/lclproc.pas svneol=native#text/pascal
 lcl/lclrescache.pas svneol=native#text/pascal
 lcl/lclstrconsts.pas svneol=native#text/pascal
 lcl/lcltype.pp svneol=native#text/pascal
+lcl/ldockctrl.pas svneol=native#text/plain
+lcl/ldockctrledit.lfm svneol=native#text/plain
+lcl/ldockctrledit.lrs svneol=native#text/plain
+lcl/ldockctrledit.pas svneol=native#text/plain
 lcl/ldocktree.pas svneol=native#text/pascal
 lcl/lmessages.pp svneol=native#text/pascal
 lcl/lresources.pp svneol=native#text/pascal

ide/lazarusidestrconsts.pas

@@ -1977,6 +1977,9 @@ resourcestring
   // file checks
   lisUnableToCreateFile = 'Unable to create file';
   lisCanNotCreateFile = 'Can not create file %s%s%s';
+  lisExtendUnitPath = 'Extend unit path?';
+  lisTheDirectoryIsNotYetInTheUnitPathAddIt = 'The directory %s%s%s is not '
+    +'yet in the unit path.%sAdd it?';
   lisUnableToCreateFilename = 'Unable to create file %s%s%s.';
   lisUnableToWriteFile = 'Unable to write file';
   lisUnableToWriteFile2 = 'Unable to write file %s%s%s';
@@ -2055,6 +2058,9 @@ resourcestring
   lisExecutionPausedAdress = 'Execution paused%s  Adress: $%s%s  Procedure: %'
     +'s%s  File: %s%s(Some day an assembler window might popup here :)%s';
   lisFileNotFound = 'File not found';
+  lisCleanUpUnitPath = 'Clean up unit path?';
+  lisTheDirectoryIsNoLongerNeededInTheUnitPathRemoveIt = 'The directory %s%s%'
+    +'s is no longer needed in the unit path.%sRemove it?';
   lisTheFileWasNotFoundDoYouWantToLocateItYourself = 'The file %s%s%s%swas '
     +'not found.%sDo you want to locate it yourself ?%s';
   lisRunToFailed = 'Run-to failed';

ide/main.pp

@@ -3661,7 +3661,6 @@ begin
     FileWithoutPath:=ExtractFileName(NewFilename);
     // check if file should be auto renamed
 
-
     if EnvironmentOptions.CharcaseFileAction = ccfaAsk then begin
       if lowercase(FileWithoutPath)<>FileWithoutPath
       then begin
@@ -4041,6 +4040,7 @@ var
   AmbiguousText: string;
   i: Integer;
   AmbiguousFilename: String;
+  OldUnitPath: String;
 begin
   OldFilename:=AnUnitInfo.Filename;
   OldFilePath:=ExtractFilePath(OldFilename);
@@ -4095,6 +4095,25 @@ begin
   NewFilePath:=ExtractFilePath(NewFilename);
   EnvironmentOptions.AddToRecentOpenFiles(NewFilename);
   SetRecentFilesMenu;
+  
+  // add new path to unit path
+  if AnUnitInfo.IsPartOfProject
+  and (FilenameIsPascalUnit(NewFilename))
+  and (CompareFilenames(NewFilePath,Project1.ProjectDirectory)<>0) then begin
+    OldUnitPath:=Project1.CompilerOptions.GetUnitPath(false);
+    
+    if SearchDirectoryInSearchPath(OldUnitPath,NewFilePath,1)<1 then begin
+      //DebugLn('TMainIDE.DoRenameUnit NewFilePath="',NewFilePath,'" OldUnitPath="',OldUnitPath,'"');
+      if MessageDlg(lisExtendUnitPath,
+        Format(lisTheDirectoryIsNotYetInTheUnitPathAddIt, ['"', NewFilePath,
+          '"', #13]),
+        mtConfirmation,[mbYes,mbNo],0)=mrYes then
+      begin
+        Project1.CompilerOptions.OtherUnitFiles:=
+                        Project1.CompilerOptions.OtherUnitFiles+';'+NewFilePath;
+      end;
+    end;
+  end;
 
   // rename Resource file
   if (ResourceCode<>nil) then begin
@@ -4213,6 +4232,31 @@ begin
     end;
   end;
 
+  // remove old path from unit path
+  if AnUnitInfo.IsPartOfProject
+  and (FilenameIsPascalUnit(OldFilename))
+  and (OldFilePath<>'') then begin
+    //DebugLn('TMainIDE.DoRenameUnit OldFilePath="',OldFilePath,'" SourceDirs="',Project1.SourceDirectories.CreateSearchPathFromAllFiles,'"');
+    if (SearchDirectoryInSearchPath(
+       Project1.SourceDirectories.CreateSearchPathFromAllFiles,OldFilePath,1)<1)
+    then begin
+      //DebugLn('TMainIDE.DoRenameUnit OldFilePath="',OldFilePath,'" UnitPath="',Project1.CompilerOptions.GetUnitPath(false),'"');
+      if (SearchDirectoryInSearchPath(
+                   Project1.CompilerOptions.GetUnitPath(false),OldFilePath,1)<1)
+      then begin
+        if MessageDlg(lisCleanUpUnitPath,
+            Format(lisTheDirectoryIsNoLongerNeededInTheUnitPathRemoveIt, ['"',
+              OldFilePath, '"', #13]),
+            mtConfirmation,[mbYes,mbNo],0)=mrYes then
+        begin
+          Project1.CompilerOptions.OtherUnitFiles:=
+                      RemoveSearchPaths(Project1.CompilerOptions.OtherUnitFiles,
+                                        OldUnitPath);
+        end;
+      end;
+    end;
+  end;
+
   Result:=mrOk;
 end;
 

ideintf/menuintf.pas

@@ -29,8 +29,7 @@ unit MenuIntf;
 interface
 
 uses
-  Classes, SysUtils, LCLProc, Menus, ImgList, Graphics, TextTools, HelpIntf,
+  Classes, SysUtils, LCLProc, Menus, ImgList, Graphics, HelpIntf, IDECommands;
-  IDECommands;
   
 type
   TIDEMenuItem = class;

ideintf/texttools.pas

@@ -82,10 +82,6 @@ function RESplit(const TheText, SeparatorRegExpr: string;
 procedure RESplit(const TheText, SeparatorRegExpr: string; Pieces: TStrings;
                   const ModifierStr: string = '');
 
-// identifier
-function CreateFirstIdentifier(const Identifier: string): string;
-function CreateNextIdentifier(const Identifier: string): string;
-
 // xml paths
 function GetPathElement(const Path: string; StartPos: integer;
                         Stopper: char): string;
@@ -157,27 +153,6 @@ begin
   RESplit(TheText,SeparatorRegExpr,Result,ModifierStr);
 end;
 
-function CreateFirstIdentifier(const Identifier: string): string;
-// example: Ident59 becomes Ident1
-var
-  p: Integer;
-begin
-  p:=length(Identifier);
-  while (p>=1) and (Identifier[p] in ['0'..'9']) do dec(p);
-  Result:=copy(Identifier,1,p)+'1';
-end;
-
-function CreateNextIdentifier(const Identifier: string): string;
-// example: Ident59 becomes Ident60
-var
-  p: Integer;
-begin
-  p:=length(Identifier);
-  while (p>=1) and (Identifier[p] in ['0'..'9']) do dec(p);
-  Result:=copy(Identifier,1,p)
-          +IntToStr(1+StrToIntDef(copy(Identifier,p+1,length(Identifier)-p),0));
-end;
-
 function GetPathElement(const Path: string; StartPos: integer;
   Stopper: char): string;
 var

lcl/alllclunits.pp

@@ -48,7 +48,7 @@ uses
   Dialogs, Messages, Clistbox, ActnList, Grids, MaskEdit,
   Printers, PostScriptPrinter, PostScriptCanvas, CheckLst, PairSplitter,
   ExtDlgs, DBCtrls, DBGrids, DBActns, EditBtn, ExtGraphics, ColorBox,
-  PropertyStorage, IniPropStorage, XMLPropStorage, Chart, LDockTree,
+  PropertyStorage, IniPropStorage, XMLPropStorage, Chart, LDockTree, LDockCtrl,
   // widgetset skeleton
   WSActnList, WSArrow, WSButtons, WSCalendar,
   WSCheckLst, WSCListBox, WSComCtrls, WSControls,

lcl/lclproc.pas

@@ -196,6 +196,10 @@ function UTF8CharStart(UTF8Str: PChar; Len, Index: integer): PChar;
 procedure UTF8FixBroken(P: PChar);
 function UTF8CStringToUTF8String(SourceStart: PChar; SourceLen: SizeInt) : string;
 
+// identifier
+function CreateFirstIdentifier(const Identifier: string): string;
+function CreateNextIdentifier(const Identifier: string): string;
+
 
 // ======================================================================
 // Endian utility functions
@@ -1740,6 +1744,28 @@ begin
   SetLength(Result, Dest - PChar(Result));
 end;
 
+function CreateFirstIdentifier(const Identifier: string): string;
+// example: Ident59 becomes Ident1
+var
+  p: Integer;
+begin
+  p:=length(Identifier);
+  while (p>=1) and (Identifier[p] in ['0'..'9']) do dec(p);
+  Result:=copy(Identifier,1,p)+'1';
+end;
+
+function CreateNextIdentifier(const Identifier: string): string;
+// example: Ident59 becomes Ident60
+var
+  p: Integer;
+begin
+  p:=length(Identifier);
+  while (p>=1) and (Identifier[p] in ['0'..'9']) do dec(p);
+  Result:=copy(Identifier,1,p)
+          +IntToStr(1+StrToIntDef(copy(Identifier,p+1,length(Identifier)-p),0));
+end;
+
+
 //==============================================================================
 // Endian utils
 //==============================================================================

lcl/ldockctrl.pas

@@ -0,0 +1,357 @@
+{  $Id: ldocktree.pas 8153 2005-11-14 21:53:06Z mattias $  }
+{
+ /***************************************************************************
+                               LDockCtrl.pas
+                             -----------------
+
+ ***************************************************************************/
+
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.LCL, included in this distribution,                 *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program 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.                     *
+ *                                                                           *
+ *****************************************************************************
+
+  Author: Mattias Gaertner
+
+  Abstract:
+    This unit contains visual components for docking.
+}
+unit LDockCtrl;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LCLProc, Controls, Forms, Menus, LCLStrConsts,
+  LDockCtrlEdit, LDockTree;
+
+type
+  TCustomLazControlDocker = class;
+
+  { TCustomLazDockingManager }
+
+  TCustomLazDockingManager = class(TComponent)
+  private
+    FDockerCount: Integer;
+    FDockers: TFPList;
+    FManager: TAnchoredDockManager;
+    function GetDockers(Index: Integer): TCustomLazControlDocker;
+  protected
+    procedure Remove(Docker: TCustomLazControlDocker);
+    function Add(Docker: TCustomLazControlDocker): Integer;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    function FindDockerByName(const ADockerName: string;
+                      Ignore: TCustomLazControlDocker): TCustomLazControlDocker;
+    function CreateUniqueName(const AName: string;
+                              Ignore: TCustomLazControlDocker): string;
+    property Manager: TAnchoredDockManager read FManager;
+    property DockerCount: Integer read FDockerCount;
+    property Dockers[Index: Integer]: TCustomLazControlDocker read GetDockers; default;
+  end;
+
+  { TLazDockingManager }
+
+  TLazDockingManager = class(TCustomLazDockingManager)
+  published
+  end;
+
+  { TCustomLazControlDocker - a component to mark a form for the TLazDockingManager }
+
+  TCustomLazControlDocker = class(TComponent)
+  private
+    FControl: TControl;
+    FDockerName: string;
+    FExtendPopupMenu: boolean;
+    FLocalizedName: string;
+    FManager: TCustomLazDockingManager;
+    FPopupMenuItem: TMenuItem;
+    procedure SetControl(const AValue: TControl);
+    procedure SetDockerName(const AValue: string);
+    procedure SetExtendPopupMenu(const AValue: boolean);
+    procedure SetLocalizedName(const AValue: string);
+    procedure SetManager(const AValue: TCustomLazDockingManager);
+    procedure PopupMenuItemClick(Sender: TObject);
+  protected
+    procedure UpdatePopupMenu; virtual;
+    procedure Loaded; override;
+    procedure ShowDockingEditor; virtual;
+    function GetLocalizedName: string;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    property Control: TControl read FControl write SetControl;
+    property Manager: TCustomLazDockingManager read FManager write SetManager;
+    property ExtendPopupMenu: boolean read FExtendPopupMenu write SetExtendPopupMenu;
+    property PopupMenuItem: TMenuItem read FPopupMenuItem;
+    property LocalizedName: string read FLocalizedName write SetLocalizedName;
+    property DockerName: string read FDockerName write SetDockerName;
+  end;
+
+  { TLazControlDocker }
+
+  TLazControlDocker = class(TCustomLazControlDocker)
+  published
+    property Control;
+    property Manager;
+    property ExtendPopupMenu;
+    property DockerName;
+  end;
+  
+procedure Register;
+
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('Misc',[TLazDockingManager,TLazControlDocker]);
+end;
+
+{ TCustomLazControlDocker }
+
+procedure TCustomLazControlDocker.SetManager(
+  const AValue: TCustomLazDockingManager);
+begin
+  if FManager=AValue then exit;
+  if FManager<>nil then FManager.Remove(Self);
+  FManager:=AValue;
+  if FManager<>nil then FManager.Add(Self);
+  UpdatePopupMenu;
+end;
+
+procedure TCustomLazControlDocker.UpdatePopupMenu;
+// creates or deletes the PopupMenuItem to the PopupMenu of Control
+begin
+  if [csDestroying,csDesigning]*ComponentState<>[] then exit;
+  if csLoading in ComponentState then exit;
+
+  if ExtendPopupMenu and (Control<>nil) and (Control.PopupMenu<>nil)
+  and (Manager<>nil) then begin
+    if (PopupMenuItem<>nil) and (PopupMenuItem.Parent<>Control.PopupMenu.Items)
+    then begin
+      // PopupMenuItem is in the old PopupMenu -> delete it
+      FreeAndNil(FPopupMenuItem);
+    end;
+    if (PopupMenuItem=nil) then begin
+      // create a new PopupMenuItem
+      FPopupMenuItem:=TMenuItem.Create(Self);
+      PopupMenuItem.Caption:=rsDocking;
+      PopupMenuItem.OnClick:=@PopupMenuItemClick;
+    end;
+    if PopupMenuItem.Parent=nil then begin
+      // add PopupMenuItem to Control.PopupMenu
+      Control.PopupMenu.Items.Add(PopupMenuItem);
+    end;
+  end else begin
+    // delete PopupMenuItem
+    FreeAndNil(FPopupMenuItem);
+  end;
+end;
+
+procedure TCustomLazControlDocker.Loaded;
+begin
+  inherited Loaded;
+  UpdatePopupMenu;
+end;
+
+procedure TCustomLazControlDocker.ShowDockingEditor;
+var
+  Dlg: TLazDockControlEditorDlg;
+  i: Integer;
+  TargetDocker: TCustomLazControlDocker;
+  Side: TAlign;
+  CurDocker: TCustomLazControlDocker;
+begin
+  Dlg:=TLazDockControlEditorDlg.Create(nil);
+  try
+    // fill the list of controls this control can dock to
+    Dlg.DockControlComboBox.Text:='';
+    Dlg.DockControlComboBox.Items.BeginUpdate;
+    try
+      Dlg.DockControlComboBox.Items.Clear;
+      for i:=0 to Manager.DockerCount-1 do begin
+        CurDocker:=Manager.Dockers[i];
+        if CurDocker=Self then continue;
+        if CurDocker.Control=nil then continue;
+        Dlg.DockControlComboBox.Items.Add(CurDocker.GetLocalizedName);
+      end;
+      Dlg.DockControlComboBox.Enabled:=Dlg.DockControlComboBox.Items.Count>0;
+    finally
+      Dlg.DockControlComboBox.Items.EndUpdate;
+    end;
+
+    // enable Undock button, if Control is docked
+    Dlg.UndockGroupBox.Enabled:=(Control.Parent<>nil)
+                                 and (Control.Parent<>Control.HostDockSite);
+    
+    if Dlg.ShowModal=mrOk then begin
+      // dock or undock
+      case Dlg.DlgResult of
+      ldcedrUndock:
+        // undock
+        Manager.Manager.UndockControl(Control,true);
+      ldcedrDockLeft,ldcedrDockRight,ldcedrDockTop,
+        ldcedrDockBottom,ldcedrDockPage:
+        // dock
+        begin
+          TargetDocker:=nil;
+          for i:=0 to Manager.DockerCount-1 do begin
+            CurDocker:=Manager.Dockers[i];
+            if CurDocker=Self then continue;
+            if Dlg.DockControlComboBox.Text=CurDocker.GetLocalizedName then
+              TargetDocker:=CurDocker;
+          end;
+          if TargetDocker=nil then begin
+            RaiseGDBException('TCustomLazControlDocker.ShowDockingEditor TargetDocker=nil');
+          end;
+          case Dlg.DlgResult of
+          ldcedrDockLeft: Side:=alLeft;
+          ldcedrDockRight: Side:=alRight;
+          ldcedrDockTop: Side:=alTop;
+          ldcedrDockBottom: Side:=alBottom;
+          ldcedrDockPage: Side:=alClient;
+          else RaiseGDBException('TCustomLazControlDocker.ShowDockingEditor ?');
+          end;
+          Manager.Manager.DockControl(Control,Side,TargetDocker.Control);
+        end;
+      end;
+    end;
+  finally
+    Dlg.Free;
+  end;
+end;
+
+function TCustomLazControlDocker.GetLocalizedName: string;
+begin
+  Result:=LocalizedName;
+  if LocalizedName='' then begin
+    Result:=DockerName;
+    if (Result='') and (Control<>nil) then
+      Result:=Control.Name;
+    if Result='' then
+      Result:=Name;
+  end;
+end;
+
+constructor TCustomLazControlDocker.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  if (not (csLoading in ComponentState))
+  and (TheOwner is TControl) then
+    // use as default
+    Control:=TControl(TheOwner);
+  ExtendPopupMenu:=true;
+end;
+
+procedure TCustomLazControlDocker.PopupMenuItemClick(Sender: TObject);
+begin
+  ShowDockingEditor;
+end;
+
+procedure TCustomLazControlDocker.SetControl(const AValue: TControl);
+begin
+  if FControl=AValue then exit;
+  FControl:=AValue;
+  if DockerName='' then
+    DockerName:=AValue.Name;
+  UpdatePopupMenu;
+end;
+
+procedure TCustomLazControlDocker.SetDockerName(const AValue: string);
+var
+  NewDockerName: String;
+begin
+  if FDockerName=AValue then exit;
+  NewDockerName:=AValue;
+  if Manager<>nil then
+    NewDockerName:=Manager.CreateUniqueName(NewDockerName,Self);
+  FDockerName:=NewDockerName;
+end;
+
+procedure TCustomLazControlDocker.SetExtendPopupMenu(const AValue: boolean);
+begin
+  if FExtendPopupMenu=AValue then exit;
+  FExtendPopupMenu:=AValue;
+  UpdatePopupMenu;
+end;
+
+procedure TCustomLazControlDocker.SetLocalizedName(const AValue: string);
+begin
+  if FLocalizedName=AValue then exit;
+  FLocalizedName:=AValue;
+end;
+
+{ TCustomLazDockingManager }
+
+procedure TCustomLazDockingManager.Remove(Docker: TCustomLazControlDocker);
+begin
+  FDockers.Remove(Docker);
+end;
+
+function TCustomLazDockingManager.Add(Docker: TCustomLazControlDocker): Integer;
+begin
+  Docker.DockerName:=CreateUniqueName(Docker.DockerName,nil);
+  Result:=FDockers.Add(Docker);
+end;
+
+function TCustomLazDockingManager.GetDockers(Index: Integer
+  ): TCustomLazControlDocker;
+begin
+  Result:=TCustomLazControlDocker(FDockers[Index]);
+end;
+
+constructor TCustomLazDockingManager.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  FDockers:=TFPList.Create;
+  FManager:=TAnchoredDockManager.Create;
+end;
+
+destructor TCustomLazDockingManager.Destroy;
+var
+  i: Integer;
+begin
+  for i:=FDockers.Count-1 downto 0 do
+    Dockers[i].Manager:=nil;
+  FreeAndNil(FDockers);
+  FreeAndNil(FManager);
+  inherited Destroy;
+end;
+
+function TCustomLazDockingManager.FindDockerByName(const ADockerName: string;
+  Ignore: TCustomLazControlDocker): TCustomLazControlDocker;
+var
+  i: Integer;
+begin
+  i:=DockerCount-1;
+  while (i>=0) do begin
+    Result:=Dockers[i];
+    if (CompareText(Result.DockerName,ADockerName)=0) and (Ignore<>Result) then
+      exit;
+    dec(i);
+  end;
+  Result:=nil;
+end;
+
+function TCustomLazDockingManager.CreateUniqueName(const AName: string;
+  Ignore: TCustomLazControlDocker): string;
+begin
+  Result:=AName;
+  if FindDockerByName(Result,Ignore)=nil then exit;
+  Result:=CreateFirstIdentifier(Result);
+  while FindDockerByName(Result,Ignore)<>nil do
+    Result:=CreateNextIdentifier(Result);
+end;
+
+end.
+

lcl/ldockctrledit.lfm

@@ -0,0 +1,162 @@
+object LazDockControlEditorDlg: TLazDockControlEditorDlg
+  ActiveControl = UndockButton
+  Caption = 'LazDockControlEditorDlg'
+  ClientHeight = 315
+  ClientWidth = 310
+  OnCreate = FormCreate
+  PixelsPerInch = 112
+  HorzScrollBar.Page = 309
+  VertScrollBar.Page = 314
+  Left = 286
+  Height = 315
+  Top = 202
+  Width = 310
+  object UndockGroupBox: TGroupBox
+    Anchors = [akTop, akLeft, akRight]
+    AutoSize = True
+    Caption = 'UndockGroupBox'
+    ChildSizing.HorizontalSpacing = 5
+    ChildSizing.VerticalSpacing = 5
+    ClientHeight = 9
+    ClientWidth = 291
+    TabOrder = 0
+    Left = 8
+    Height = 26
+    Top = 8
+    Width = 295
+    object UndockButton: TButton
+      AutoSize = True
+      BorderSpacing.InnerBorder = 2
+      Caption = 'UndockButton'
+      OnClick = UndockButtonClick
+      TabOrder = 0
+      Left = 6
+      Height = 26
+      Width = 87
+    end
+  end
+  object DockGroupBox: TGroupBox
+    Anchors = [akTop, akLeft, akRight]
+    AutoSize = True
+    Caption = 'DockGroupBox'
+    ChildSizing.HorizontalSpacing = 5
+    ChildSizing.VerticalSpacing = 5
+    ClientHeight = 180
+    ClientWidth = 291
+    TabOrder = 1
+    Left = 8
+    Height = 197
+    Top = 56
+    Width = 295
+    object DockControlLabel: TLabel
+      BorderSpacing.Around = 2
+      Caption = 'DockControlLabel'
+      Color = clNone
+      ParentColor = False
+      AnchorSideTop.Control = DockControlComboBox
+      AnchorSideTop.Side = asrCenter
+      Left = 10
+      Height = 13
+      Top = 6
+      Width = 101
+    end
+    object DockLeftButton: TButton
+      AutoSize = True
+      BorderSpacing.Top = 5
+      BorderSpacing.InnerBorder = 2
+      Caption = 'DockLeftButton'
+      OnClick = DockLeftButtonClick
+      TabOrder = 0
+      AnchorSideTop.Control = DockControlComboBox
+      Left = 6
+      Height = 26
+      Top = 30
+      Width = 94
+    end
+    object DockRightButton: TButton
+      AutoSize = True
+      BorderSpacing.Top = 5
+      BorderSpacing.InnerBorder = 2
+      Caption = 'DockRightButton'
+      OnClick = DockRightButtonClick
+      TabOrder = 1
+      AnchorSideLeft.Control = DockLeftButton
+      AnchorSideLeft.Side = asrTop
+      AnchorSideTop.Control = DockLeftButton
+      Left = 6
+      Height = 26
+      Top = 61
+      Width = 102
+    end
+    object DockTopButton: TButton
+      AutoSize = True
+      BorderSpacing.Top = 5
+      BorderSpacing.InnerBorder = 2
+      Caption = 'DockTopButton'
+      OnClick = DockTopButtonClick
+      TabOrder = 2
+      AnchorSideLeft.Control = DockLeftButton
+      AnchorSideLeft.Side = asrTop
+      AnchorSideTop.Control = DockRightButton
+      Left = 6
+      Height = 26
+      Top = 92
+      Width = 95
+    end
+    object DockBottomButton: TButton
+      AutoSize = True
+      BorderSpacing.Top = 5
+      BorderSpacing.InnerBorder = 2
+      Caption = 'DockBottomButton'
+      OnClick = DockBottomButtonClick
+      TabOrder = 3
+      AnchorSideLeft.Control = DockLeftButton
+      AnchorSideLeft.Side = asrTop
+      AnchorSideTop.Control = DockTopButton
+      Left = 6
+      Height = 26
+      Top = 123
+      Width = 111
+    end
+    object DockPageButton: TButton
+      AutoSize = True
+      BorderSpacing.Top = 5
+      BorderSpacing.InnerBorder = 2
+      Caption = 'DockPageButton'
+      OnClick = DockPageButtonClick
+      TabOrder = 4
+      AnchorSideLeft.Control = DockLeftButton
+      AnchorSideLeft.Side = asrTop
+      AnchorSideTop.Control = DockBottomButton
+      Left = 6
+      Height = 26
+      Top = 154
+      Width = 103
+    end
+    object DockControlComboBox: TComboBox
+      Anchors = [akTop, akLeft, akRight]
+      BorderSpacing.Left = 4
+      MaxLength = 0
+      OnEditingDone = DockControlComboBoxEditingDone
+      TabOrder = 5
+      Text = 'DockControlComboBox'
+      AnchorSideLeft.Control = DockControlLabel
+      Left = 115
+      Height = 25
+      Width = 171
+    end
+  end
+  object CancelButton: TButton
+    Anchors = [akTop]
+    AutoSize = True
+    BorderSpacing.Top = 10
+    BorderSpacing.InnerBorder = 2
+    Caption = 'CancelButton'
+    TabOrder = 2
+    AnchorSideTop.Control = DockGroupBox
+    Left = 112
+    Height = 26
+    Top = 263
+    Width = 85
+  end
+end

lcl/ldockctrledit.lrs

@@ -0,0 +1,56 @@
+{ Dies ist eine automatisch erzeugte Lazarus-Ressourcendatei }
+
+LazarusResources.Add('TLazDockControlEditorDlg','FORMDATA',[
+  'TPF0'#24'TLazDockControlEditorDlg'#23'LazDockControlEditorDlg'#13'ActiveCont'
+  +'rol'#7#12'UndockButton'#7'Caption'#6#23'LazDockControlEditorDlg'#12'ClientH'
+  +'eight'#3';'#1#11'ClientWidth'#3'6'#1#8'OnCreate'#7#10'FormCreate'#13'Pixels'
+  +'PerInch'#2'p'#18'HorzScrollBar.Page'#3'5'#1#18'VertScrollBar.Page'#3':'#1#4
+  +'Left'#3#30#1#6'Height'#3';'#1#3'Top'#3#202#0#5'Width'#3'6'#1#0#9'TGroupBox'
+  +#14'UndockGroupBox'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'AutoSize'
+  +#9#7'Caption'#6#14'UndockGroupBox'#29'ChildSizing.HorizontalSpacing'#2#5#27
+  +'ChildSizing.VerticalSpacing'#2#5#12'ClientHeight'#2#9#11'ClientWidth'#3'#'#1
+  +#8'TabOrder'#2#0#4'Left'#2#8#6'Height'#2#26#3'Top'#2#8#5'Width'#3''''#1#0#7
+  +'TButton'#12'UndockButton'#8'AutoSize'#9#25'BorderSpacing.InnerBorder'#2#2#7
+  +'Caption'#6#12'UndockButton'#7'OnClick'#7#17'UndockButtonClick'#8'TabOrder'#2
+  +#0#4'Left'#2#6#6'Height'#2#26#5'Width'#2'W'#0#0#0#9'TGroupBox'#12'DockGroupB'
+  +'ox'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'AutoSize'#9#7'Caption'#6
+  +#12'DockGroupBox'#29'ChildSizing.HorizontalSpacing'#2#5#27'ChildSizing.Verti'
+  +'calSpacing'#2#5#12'ClientHeight'#3#180#0#11'ClientWidth'#3'#'#1#8'TabOrder'
+  +#2#1#4'Left'#2#8#6'Height'#3#197#0#3'Top'#2'8'#5'Width'#3''''#1#0#6'TLabel'
+  +#16'DockControlLabel'#20'BorderSpacing.Around'#2#2#7'Caption'#6#16'DockContr'
+  +'olLabel'#5'Color'#7#6'clNone'#11'ParentColor'#8#21'AnchorSideTop.Control'#7
+  +#19'DockControlComboBox'#18'AnchorSideTop.Side'#7#9'asrCenter'#4'Left'#2#10#6
+  +'Height'#2#13#3'Top'#2#6#5'Width'#2'e'#0#0#7'TButton'#14'DockLeftButton'#8'A'
+  +'utoSize'#9#17'BorderSpacing.Top'#2#5#25'BorderSpacing.InnerBorder'#2#2#7'Ca'
+  +'ption'#6#14'DockLeftButton'#7'OnClick'#7#19'DockLeftButtonClick'#8'TabOrder'
+  +#2#0#21'AnchorSideTop.Control'#7#19'DockControlComboBox'#4'Left'#2#6#6'Heigh'
+  +'t'#2#26#3'Top'#2#30#5'Width'#2'^'#0#0#7'TButton'#15'DockRightButton'#8'Auto'
+  +'Size'#9#17'BorderSpacing.Top'#2#5#25'BorderSpacing.InnerBorder'#2#2#7'Capti'
+  +'on'#6#15'DockRightButton'#7'OnClick'#7#20'DockRightButtonClick'#8'TabOrder'
+  +#2#1#22'AnchorSideLeft.Control'#7#14'DockLeftButton'#19'AnchorSideLeft.Side'
+  +#7#6'asrTop'#21'AnchorSideTop.Control'#7#14'DockLeftButton'#4'Left'#2#6#6'He'
+  +'ight'#2#26#3'Top'#2'='#5'Width'#2'f'#0#0#7'TButton'#13'DockTopButton'#8'Aut'
+  +'oSize'#9#17'BorderSpacing.Top'#2#5#25'BorderSpacing.InnerBorder'#2#2#7'Capt'
+  +'ion'#6#13'DockTopButton'#7'OnClick'#7#18'DockTopButtonClick'#8'TabOrder'#2#2
+  +#22'AnchorSideLeft.Control'#7#14'DockLeftButton'#19'AnchorSideLeft.Side'#7#6
+  +'asrTop'#21'AnchorSideTop.Control'#7#15'DockRightButton'#4'Left'#2#6#6'Heigh'
+  +'t'#2#26#3'Top'#2'\'#5'Width'#2'_'#0#0#7'TButton'#16'DockBottomButton'#8'Aut'
+  +'oSize'#9#17'BorderSpacing.Top'#2#5#25'BorderSpacing.InnerBorder'#2#2#7'Capt'
+  +'ion'#6#16'DockBottomButton'#7'OnClick'#7#21'DockBottomButtonClick'#8'TabOrd'
+  +'er'#2#3#22'AnchorSideLeft.Control'#7#14'DockLeftButton'#19'AnchorSideLeft.S'
+  +'ide'#7#6'asrTop'#21'AnchorSideTop.Control'#7#13'DockTopButton'#4'Left'#2#6#6
+  +'Height'#2#26#3'Top'#2'{'#5'Width'#2'o'#0#0#7'TButton'#14'DockPageButton'#8
+  +'AutoSize'#9#17'BorderSpacing.Top'#2#5#25'BorderSpacing.InnerBorder'#2#2#7'C'
+  +'aption'#6#14'DockPageButton'#7'OnClick'#7#19'DockPageButtonClick'#8'TabOrde'
+  +'r'#2#4#22'AnchorSideLeft.Control'#7#14'DockLeftButton'#19'AnchorSideLeft.Si'
+  +'de'#7#6'asrTop'#21'AnchorSideTop.Control'#7#16'DockBottomButton'#4'Left'#2#6
+  +#6'Height'#2#26#3'Top'#3#154#0#5'Width'#2'g'#0#0#9'TComboBox'#19'DockControl'
+  +'ComboBox'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#18'BorderSpacing.Le'
+  +'ft'#2#4#9'MaxLength'#2#0#13'OnEditingDone'#7#30'DockControlComboBoxEditingD'
+  +'one'#8'TabOrder'#2#5#4'Text'#6#19'DockControlComboBox'#22'AnchorSideLeft.Co'
+  +'ntrol'#7#16'DockControlLabel'#4'Left'#2's'#6'Height'#2#25#5'Width'#3#171#0#0
+  +#0#0#7'TButton'#12'CancelButton'#7'Anchors'#11#5'akTop'#0#8'AutoSize'#9#17'B'
+  +'orderSpacing.Top'#2#10#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#12'Ca'
+  +'ncelButton'#8'TabOrder'#2#2#21'AnchorSideTop.Control'#7#12'DockGroupBox'#4
+  +'Left'#2'p'#6'Height'#2#26#3'Top'#3#7#1#5'Width'#2'U'#0#0#0
+]);

lcl/ldockctrledit.pas

@@ -0,0 +1,179 @@
+{  $Id: ldocktree.pas 8153 2005-11-14 21:53:06Z mattias $  }
+{
+ /***************************************************************************
+                             LDockCtrlEdit.pas
+                             -----------------
+
+ ***************************************************************************/
+
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.LCL, included in this distribution,                 *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program 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.                     *
+ *                                                                           *
+ *****************************************************************************
+
+  Author: Mattias Gaertner
+
+  Abstract:
+    This unit contains a dialog to dock or undock a control to another.
+}
+unit LDockCtrlEdit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
+  StdCtrls;
+
+type
+  TLazDockControlEditorDlgResult = (
+    ldcedrNone,
+    ldcedrUndock,
+    ldcedrDockLeft,
+    ldcedrDockRight,
+    ldcedrDockTop,
+    ldcedrDockBottom,
+    ldcedrDockPage
+    );
+
+  { TLazDockControlEditorDlg }
+
+  TLazDockControlEditorDlg = class(TForm)
+    CancelButton: TButton;
+    DockControlComboBox: TComboBox;
+    DockPageButton: TButton;
+    DockBottomButton: TButton;
+    DockTopButton: TButton;
+    DockRightButton: TButton;
+    DockLeftButton: TButton;
+    DockGroupBox: TGroupBox;
+    DockControlLabel: TLabel;
+    UndockButton: TButton;
+    UndockGroupBox: TGroupBox;
+    procedure DockBottomButtonClick(Sender: TObject);
+    procedure DockControlComboBoxEditingDone(Sender: TObject);
+    procedure DockLeftButtonClick(Sender: TObject);
+    procedure DockPageButtonClick(Sender: TObject);
+    procedure DockRightButtonClick(Sender: TObject);
+    procedure DockTopButtonClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure UndockButtonClick(Sender: TObject);
+  private
+    FCurrentControlName: string;
+    FDlgResult: TLazDockControlEditorDlgResult;
+    procedure CheckSetDlgResult(NewDlgResult: TLazDockControlEditorDlgResult);
+    procedure SetCurrentControlName(const AValue: string);
+    procedure UpdateButtonEnabled;
+  public
+    property DlgResult: TLazDockControlEditorDlgResult read FDlgResult write FDlgResult;
+    property CurrentControlName: string read FCurrentControlName write SetCurrentControlName;
+  end;
+
+implementation
+
+{ TLazDockControlEditorDlg }
+
+procedure TLazDockControlEditorDlg.FormCreate(Sender: TObject);
+begin
+  Caption:='Docking';
+  
+  UndockGroupBox.Caption:='Undock';
+  UndockButton.Caption:='Undock (make it a single, normal window)';
+
+  DockPageButton.Caption:='Dock as page';
+  DockBottomButton.Caption:='Dock to bottom';
+  DockTopButton.Caption:='Dock to top';
+  DockRightButton.Caption:='Dock to right';
+  DockLeftButton.Caption:='Dock to left';
+  DockGroupBox.Caption:='Dock to control';
+  DockControlLabel.Caption:='To control';
+  
+  UpdateButtonEnabled;
+end;
+
+procedure TLazDockControlEditorDlg.DockLeftButtonClick(Sender: TObject);
+begin
+  CheckSetDlgResult(ldcedrDockLeft);
+end;
+
+procedure TLazDockControlEditorDlg.DockPageButtonClick(Sender: TObject);
+begin
+  CheckSetDlgResult(ldcedrDockPage);
+end;
+
+procedure TLazDockControlEditorDlg.DockBottomButtonClick(Sender: TObject);
+begin
+  CheckSetDlgResult(ldcedrDockBottom);
+end;
+
+procedure TLazDockControlEditorDlg.DockControlComboBoxEditingDone(
+  Sender: TObject);
+begin
+  UpdateButtonEnabled;
+end;
+
+procedure TLazDockControlEditorDlg.DockRightButtonClick(Sender: TObject);
+begin
+  CheckSetDlgResult(ldcedrDockRight);
+end;
+
+procedure TLazDockControlEditorDlg.DockTopButtonClick(Sender: TObject);
+begin
+  CheckSetDlgResult(ldcedrDockTop);
+end;
+
+procedure TLazDockControlEditorDlg.UndockButtonClick(Sender: TObject);
+begin
+  CheckSetDlgResult(ldcedrUndock);
+end;
+
+procedure TLazDockControlEditorDlg.CheckSetDlgResult(
+  NewDlgResult: TLazDockControlEditorDlgResult);
+begin
+  if NewDlgResult in [ldcedrDockLeft,ldcedrDockRight,ldcedrDockTop,
+    ldcedrDockBottom,ldcedrDockPage] then
+  begin
+    if DockControlComboBox.Items.IndexOf(DockControlComboBox.Text)<0 then
+    begin
+      MessageDlg('Incomplete','Please select first a control,'
+        +' to which '+CurrentControlName+' should be docked.',mtError,
+        [mbCancel],0);
+      exit;
+    end;
+  end;
+  DlgResult:=NewDlgResult;
+  ModalResult:=mrOk;
+end;
+
+procedure TLazDockControlEditorDlg.SetCurrentControlName(const AValue: string);
+begin
+  if FCurrentControlName=AValue then exit;
+  FCurrentControlName:=AValue;
+end;
+
+procedure TLazDockControlEditorDlg.UpdateButtonEnabled;
+var
+  SelectionValid: Boolean;
+begin
+  SelectionValid:=DockControlComboBox.Items.IndexOf(DockControlComboBox.Text)>=0;
+  DockPageButton.Enabled:=SelectionValid;
+  DockBottomButton.Enabled:=SelectionValid;
+  DockTopButton.Enabled:=SelectionValid;
+  DockRightButton.Enabled:=SelectionValid;
+  DockLeftButton.Enabled:=SelectionValid;
+end;
+
+initialization
+  {$I ldockctrledit.lrs}
+
+end.
+

lcl/ldocktree.pas

@@ -171,65 +171,6 @@ type
   end;
   
   
-  TCustomLazControlDocker = class;
-  
-  { TCustomLazDockingManager }
-
-  TCustomLazDockingManager = class(TComponent)
-  private
-    FDockerCount: Integer;
-    FDockers: TFPList;
-    FManager: TAnchoredDockManager;
-    function GetDockers(Index: Integer): TCustomLazControlDocker;
-  protected
-    procedure Remove(Docker: TCustomLazControlDocker);
-    function Add(Docker: TCustomLazControlDocker): Integer;
-  public
-    constructor Create(TheOwner: TComponent); override;
-    destructor Destroy; override;
-    property Manager: TAnchoredDockManager read FManager;
-    property DockerCount: Integer read FDockerCount;
-    property Dockers[Index: Integer]: TCustomLazControlDocker read GetDockers;
-  end;
-  
-  { TLazDockingManager }
-
-  TLazDockingManager = class(TCustomLazDockingManager)
-  published
-  end;
-  
-  { TCustomLazControlDocker - a component to mark a form for the TLazDockingManager }
-
-  TCustomLazControlDocker = class(TComponent)
-    procedure PopupMenuItemClick(Sender: TObject);
-  private
-    FControl: TControl;
-    FExtendPopupMenu: boolean;
-    FManager: TCustomLazDockingManager;
-    FPopupMenuItem: TMenuItem;
-    procedure SetControl(const AValue: TControl);
-    procedure SetExtendPopupMenu(const AValue: boolean);
-    procedure SetManager(const AValue: TCustomLazDockingManager);
-  protected
-    procedure UpdatePopupMenu;
-    procedure Loaded; override;
-  public
-    constructor Create(TheOwner: TComponent); override;
-    property Control: TControl read FControl write SetControl;
-    property Manager: TCustomLazDockingManager read FManager write SetManager;
-    property ExtendPopupMenu: boolean read FExtendPopupMenu write SetExtendPopupMenu;
-    property PopupMenuItem: TMenuItem read FPopupMenuItem;
-  end;
-  
-  { TLazControlDocker }
-
-  TLazControlDocker = class(TCustomLazControlDocker)
-  published
-    property Control;
-    property Manager;
-    property ExtendPopupMenu;
-  end;
-
 const
   DockAlignOrientations: array[TAlign] of TDockOrientation = (
     doPages,     //alNone,
@@ -1419,114 +1360,6 @@ begin
   Result:=Parent as TLazDockPages;
 end;
 
-{ TCustomLazControlDocker }
-
-procedure TCustomLazControlDocker.SetManager(
-  const AValue: TCustomLazDockingManager);
-begin
-  if FManager=AValue then exit;
-  if FManager<>nil then FManager.Remove(Self);
-  FManager:=AValue;
-  if FManager<>nil then FManager.Add(Self);
-end;
-
-procedure TCustomLazControlDocker.UpdatePopupMenu;
-// creates or deletes the PopupMenuItem to the PopupMenu of Control
-begin
-  if [csDestroying,csDesigning]*ComponentState<>[] then exit;
-  if csLoading in ComponentState then exit;
-  
-  if ExtendPopupMenu and (Control.PopupMenu<>nil) then begin
-    if (PopupMenuItem<>nil) and (PopupMenuItem.Parent<>Control.PopupMenu.Items)
-    then begin
-      // PopupMenuItem is in the old PopupMenu -> delete it
-      FreeAndNil(FPopupMenuItem);
-    end;
-    if (PopupMenuItem=nil) then begin
-      // create a new PopupMenuItem
-      FPopupMenuItem:=TMenuItem.Create(Self);
-      PopupMenuItem.Caption:=rsDocking;
-      PopupMenuItem.OnClick:=@PopupMenuItemClick;
-    end;
-    if PopupMenuItem.Parent=nil then begin
-      // add PopupMenuItem to Control.PopupMenu
-      Control.PopupMenu.Items.Add(PopupMenuItem);
-    end;
-  end else begin
-    // delete PopupMenuItem
-    FreeAndNil(FPopupMenuItem);
-  end;
-end;
-
-procedure TCustomLazControlDocker.Loaded;
-begin
-  inherited Loaded;
-  UpdatePopupMenu;
-end;
-
-constructor TCustomLazControlDocker.Create(TheOwner: TComponent);
-begin
-  inherited Create(TheOwner);
-  if (not (csLoading in ComponentState))
-  and (TheOwner is TControl) then
-    // use as default
-    Control:=TControl(TheOwner);
-  ExtendPopupMenu:=true;
-end;
-
-procedure TCustomLazControlDocker.PopupMenuItemClick(Sender: TObject);
-begin
-
-end;
-
-procedure TCustomLazControlDocker.SetControl(const AValue: TControl);
-begin
-  if FControl=AValue then exit;
-  FControl:=AValue;
-end;
-
-procedure TCustomLazControlDocker.SetExtendPopupMenu(const AValue: boolean);
-begin
-  if FExtendPopupMenu=AValue then exit;
-  FExtendPopupMenu:=AValue;
-  UpdatePopupMenu;
-end;
-
-{ TCustomLazDockingManager }
-
-procedure TCustomLazDockingManager.Remove(Docker: TCustomLazControlDocker);
-begin
-  FDockers.Remove(Docker);
-end;
-
-function TCustomLazDockingManager.Add(Docker: TCustomLazControlDocker): Integer;
-begin
-  Result:=FDockers.Add(Docker);
-end;
-
-function TCustomLazDockingManager.GetDockers(Index: Integer
-  ): TCustomLazControlDocker;
-begin
-  Result:=TCustomLazControlDocker(FDockers[Index]);
-end;
-
-constructor TCustomLazDockingManager.Create(TheOwner: TComponent);
-begin
-  inherited Create(TheOwner);
-  FDockers:=TFPList.Create;
-  FManager:=TAnchoredDockManager.Create;
-end;
-
-destructor TCustomLazDockingManager.Destroy;
-var
-  i: Integer;
-begin
-  for i:=FDockers.Count-1 downto 0 do
-    Dockers[i].Manager:=nil;
-  FreeAndNil(FDockers);
-  FreeAndNil(FManager);
-  inherited Destroy;
-end;
 
 end.