implemented TPairSplitter streaming

git-svn-id: trunk@4298 -

components/codetools/codecompletiontool.pas

@@ -63,8 +63,8 @@ type
   TCodeCompletionCodeTool = class(TMethodJumpingCodeTool)
   private
     ASourceChangeCache: TSourceChangeCache;
-    ClassNode: TCodeTreeNode; // the class that is to be completed
+    CompletingClassNode: TCodeTreeNode; // the class that is to be completed
-    StartNode: TCodeTreeNode; // the first variable/method/GUID node in ClassNode
+    StartNode: TCodeTreeNode; // the first variable/method/GUID node in CompletingClassNode
     FAddInheritedCodeToOverrideMethod: boolean;
     FCompleteProperties: boolean;
     FirstInsert: TCodeTreeNodeExtension; // list of insert requests
@@ -110,7 +110,7 @@ type
                        SourceChangeCache: TSourceChangeCache): boolean;
   protected
     property CodeCompleteClassNode: TCodeTreeNode
-                                  read ClassNode write SetCodeCompleteClassNode;
+                                  read CompletingClassNode write SetCodeCompleteClassNode;
     property CodeCompleteSrcChgCache: TSourceChangeCache
                        read ASourceChangeCache write SetCodeCompleteSrcChgCache;
   public
@@ -163,9 +163,9 @@ procedure TCodeCompletionCodeTool.SetCodeCompleteClassNode(
   const AClassNode: TCodeTreeNode);
 begin
   FreeClassInsertionList;
-  ClassNode:=AClassNode;
+  CompletingClassNode:=AClassNode;
-  BuildSubTreeForClass(ClassNode);
+  BuildSubTreeForClass(CompletingClassNode);
-  StartNode:=ClassNode.FirstChild;
+  StartNode:=CompletingClassNode.FirstChild;
   while (StartNode<>nil) and (StartNode.FirstChild=nil) do
     StartNode:=StartNode.NextBrother;
   if StartNode<>nil then StartNode:=StartNode.FirstChild;
@@ -677,9 +677,8 @@ begin
   // find classnode
   BuildTree(false);
   if not EndOfSourceFound then exit;
-  ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
   // initialize class for code completion
-  CodeCompleteClassNode:=ClassNode;
+  CodeCompleteClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
   CodeCompleteSrcChgCache:=SourceChangeCache;
   // check if variable already exists
   if VarExistsInCodeCompleteClass(UpperCaseStr(VarName)) then begin
@@ -1267,7 +1266,7 @@ begin
           ClassSectionNode:=ClassSectionNode.PriorBrother;
       end else begin
         // insert into first published section
-        ClassSectionNode:=ClassNode.FirstChild;
+        ClassSectionNode:=CompletingClassNode.FirstChild;
         // the first class section is always a published section, even if there
         // is no 'published' keyword. If the class starts with the 'published'
         // keyword, then it will be more beautiful to insert vars and procs to
@@ -1450,10 +1449,11 @@ begin
         the first published section. But if a privat variable is already
         needed in the first published section, then the new private section
         must be inserted in front of all }
-      if (ClassNode.FirstChild.EndPos>TopMostPrivateNode.StartPos) then begin
+      if (CompletingClassNode.FirstChild.EndPos>TopMostPrivateNode.StartPos)
+      then begin
         // topmost node is in the first section
         // -> insert as the first section
-        ANode:=ClassNode.FirstChild;
+        ANode:=CompletingClassNode.FirstChild;
         NewPrivatSectionIndent:=GetLineIndent(Src,ANode.StartPos);
         if (ANode.FirstChild<>nil) and (ANode.FirstChild.Desc<>ctnClassGUID)
         then
@@ -1463,7 +1463,7 @@ begin
         PublishedNeeded:=CompareNodeIdentChars(ANode,'PUBLISHED')<>0;
       end else begin
         // default: insert new privat section behind first published section
-        ANode:=ClassNode.FirstChild;
+        ANode:=CompletingClassNode.FirstChild;
         NewPrivatSectionIndent:=GetLineIndent(Src,ANode.StartPos);
         NewPrivatSectionInsertPos:=ANode.EndPos;
       end;
@@ -1631,14 +1631,14 @@ var
   
   procedure GatherExistingClassProcBodies;
   begin
-    TypeSectionNode:=ClassNode.Parent;
+    TypeSectionNode:=CompletingClassNode.Parent;
     if (TypeSectionNode<>nil) and (TypeSectionNode.Parent<>nil)
     and (TypeSectionNode.Parent.Desc=ctnTypeSection) then
       TypeSectionNode:=TypeSectionNode.Parent;
     ClassProcs:=nil;
     ProcBodyNodes:=GatherProcNodes(TypeSectionNode,
                          [phpInUpperCase,phpIgnoreForwards,phpOnlyWithClassname],
-                         ExtractClassName(ClassNode,true));
+                         ExtractClassName(CompletingClassNode,true));
   end;
   
   procedure FindTopMostAndBottomMostProcCodies;
@@ -1707,7 +1707,7 @@ var
   
   procedure FindInsertPointForNewClass;
   begin
-    if NodeHasParentOfType(ClassNode,ctnInterface) then begin
+    if NodeHasParentOfType(CompletingClassNode,ctnInterface) then begin
       // class is in interface section
       // -> insert at the end of the implementation section
       ImplementationNode:=FindImplementationNode;
@@ -1724,7 +1724,7 @@ var
     end else begin
       // class is not in interface section
       // -> insert at the end of the type section
-      ANode:=ClassNode.Parent; // type definition
+      ANode:=CompletingClassNode.Parent; // type definition
       if ANode=nil then
         RaiseException(ctsClassNodeWithoutParentNode);
       if ANode.Parent.Desc=ctnTypeSection then
@@ -1741,7 +1741,7 @@ var
     // insert class comment
     if ClassProcs.Count>0 then begin
       ClassStartComment:=GetIndentStr(Indent)
-                          +'{ '+ExtractClassName(ClassNode,false)+' }';
+                          +'{ '+ExtractClassName(CompletingClassNode,false)+' }';
       ASourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,
          ClassStartComment);
     end;
@@ -1762,11 +1762,11 @@ begin
     {$IFDEF CTDEBUG}
     writeln('TCodeCompletionCodeTool.CreateMissingProcBodies Gather existing method declarations ... ');
     {$ENDIF}
-    TheClassName:=ExtractClassName(ClassNode,false);
+    TheClassName:=ExtractClassName(CompletingClassNode,false);
 
     // gather existing class proc definitions
     ClassProcs:=GatherProcNodes(StartNode,[phpInUpperCase,phpAddClassName],
-       ExtractClassName(ClassNode,true));
+       ExtractClassName(CompletingClassNode,true));
 
     // check for double defined methods in ClassProcs
     CheckForDoubleDefinedMethods;
@@ -1972,7 +1972,7 @@ var CleanCursorPos, Indent, insertPos: integer;
       {$IFDEF CTDEBUG}
       writeln('TCodeCompletionCodeTool.CompleteCode Complete Properties ... ');
       {$ENDIF}
-      SectionNode:=ClassNode.FirstChild;
+      SectionNode:=CompletingClassNode.FirstChild;
       while SectionNode<>nil do begin
         ANode:=SectionNode.FirstChild;
         while ANode<>nil do begin
@@ -2021,12 +2021,13 @@ var CleanCursorPos, Indent, insertPos: integer;
         // find CodeTreeNode at cursor
         CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
 
-        ClassNode:=CursorNode;
+        CompletingClassNode:=CursorNode;
-        while (ClassNode<>nil) and (ClassNode.Desc<>ctnClass) do
+        while (CompletingClassNode<>nil)
-          ClassNode:=ClassNode.Parent;
+        and (CompletingClassNode.Desc<>ctnClass) do
-        if ClassNode=nil then
+          CompletingClassNode:=CompletingClassNode.Parent;
+        if CompletingClassNode=nil then
           RaiseException('oops, I lost your class');
-        ANode:=ClassNode.Parent;
+        ANode:=CompletingClassNode.Parent;
         if ANode=nil then
           RaiseException(ctsClassNodeWithoutParentNode);
         if (ANode.Parent<>nil) and (ANode.Parent.Desc=ctnTypeSection) then

components/codetools/codetoolmanager.pas

@@ -290,24 +290,6 @@ type
     function ReplaceCode(Code: TCodeBuffer; StartX, StartY: integer;
           EndX, EndY: integer; const NewCode: string): boolean;
 
-    // functions for events in the object inspector
-    function GetCompatiblePublishedMethods(Code: TCodeBuffer;
-          const AClassName: string; TypeData: PTypeData;
-          Proc: TGetStringProc): boolean;
-    function PublishedMethodExists(Code:TCodeBuffer; const AClassName,
-          AMethodName: string; TypeData: PTypeData;
-          var MethodIsCompatible, MethodIsPublished, IdentIsMethod: boolean
-          ): boolean;
-    function JumpToPublishedMethodBody(Code: TCodeBuffer;
-          const AClassName, AMethodName: string;
-          var NewCode: TCodeBuffer;
-          var NewX, NewY, NewTopLine: integer): boolean;
-    function RenamePublishedMethod(Code: TCodeBuffer;
-          const AClassName, OldMethodName,
-          NewMethodName: string): boolean;
-    function CreatePublishedMethod(Code: TCodeBuffer; const AClassName,
-          NewMethodName: string; ATypeInfo: PTypeInfo): boolean;
-          
     // code completion = auto class completion, auto forward proc completion,
     //             local var assignment completion, event assignment completion
     function CompleteCode(Code: TCodeBuffer; X,Y,TopLine: integer;
@@ -350,6 +332,10 @@ type
     function RenameIncludeDirective(Code: TCodeBuffer; LinkIndex: integer;
           const NewFilename: string; KeepPath: boolean): boolean;
 
+    // register proc
+    function HasInterfaceRegisterProc(Code: TCodeBuffer;
+          var HasRegisterProc: boolean): boolean;
+
     // Application.Createform(ClassName,VarName) statements in program source
     function FindCreateFormStatement(Code: TCodeBuffer; StartPos: integer;
           const AClassName, AVarName: string;
@@ -374,6 +360,8 @@ type
       var AncestorClassName: string; DirtySearch: boolean): boolean;
 
     // form components
+    function CompleteComponent(Code: TCodeBuffer; AComponent: TComponent
+          ): boolean;
     function PublishedVariableExists(Code: TCodeBuffer;
           const AClassName, AVarName: string): boolean;
     function AddPublishedVariable(Code: TCodeBuffer;
@@ -384,9 +372,23 @@ type
           const AClassName, OldVariableName, NewVarName,
           VarType: shortstring): boolean;
           
-    // register
+    // functions for events in the object inspector
-    function HasInterfaceRegisterProc(Code: TCodeBuffer;
+    function GetCompatiblePublishedMethods(Code: TCodeBuffer;
-          var HasRegisterProc: boolean): boolean;
+          const AClassName: string; TypeData: PTypeData;
+          Proc: TGetStringProc): boolean;
+    function PublishedMethodExists(Code:TCodeBuffer; const AClassName,
+          AMethodName: string; TypeData: PTypeData;
+          var MethodIsCompatible, MethodIsPublished, IdentIsMethod: boolean
+          ): boolean;
+    function JumpToPublishedMethodBody(Code: TCodeBuffer;
+          const AClassName, AMethodName: string;
+          var NewCode: TCodeBuffer;
+          var NewX, NewY, NewTopLine: integer): boolean;
+    function RenamePublishedMethod(Code: TCodeBuffer;
+          const AClassName, OldMethodName,
+          NewMethodName: string): boolean;
+    function CreatePublishedMethod(Code: TCodeBuffer; const AClassName,
+          NewMethodName: string; ATypeInfo: PTypeInfo): boolean;
 
     // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
@@ -2006,6 +2008,21 @@ begin
   end;
 end;
 
+function TCodeToolManager.CompleteComponent(Code: TCodeBuffer;
+  AComponent: TComponent): boolean;
+begin
+  Result:=false;
+  {$IFDEF CTDEBUG}
+  writeln('TCodeToolManager.CompleteComponent A ',Code.Filename,' ',AComponent.Name,':',AComponent.ClassName);
+  {$ENDIF}
+  if not InitCurCodeTool(Code) then exit;
+  try
+    Result:=FCurCodeTool.CompleteComponent(AComponent,SourceChangeCache);
+  except
+    on e: Exception do Result:=HandleException(e);
+  end;
+end;
+
 function TCodeToolManager.PublishedVariableExists(Code: TCodeBuffer;
   const AClassName, AVarName: string): boolean;
 begin

components/codetools/codetoolsstrconsts.pas

@@ -52,6 +52,7 @@ ResourceString
   ctsIdentExpectedButAtomFound = 'identifier expected, but %s found';
   ctsIdentExpectedButKeyWordFound = 'identifier expected, but keyword %s found';
   ctsStrExpectedButAtomFound = '%s expected, but %s found';
+  ctsClassSNotFound = 'Class %s not found';
   ctsIdentExpectedButEOFFound = 'unexpected end of file (identifier expected)';
   ctsBracketOpenExpectedButAtomFound = 'bracket open expected, but %s found';
   ctsBracketCloseExpectedButAtomFound = 'bracket close expected, but %s found';

components/codetools/eventcodetool.pas

@@ -24,7 +24,8 @@
     TEventsCodeTool enhances TCodeCompletionCodeTool.
     TEventsCodeTool provides functions to work with published methods in the
     source. It can gather a list of compatible methods, test if method exists,
-    jump to the method body, create a method
+    jump to the method body, create a method, complete all missing published
+    variables and events from a root component.
 }
 unit EventCodeTool;
 
@@ -59,6 +60,9 @@ type
     function CollectPublishedMethods(Params: TFindDeclarationParams;
       const FoundContext: TFindContext): TIdentifierFoundResult;
   public
+    function CompleteComponent(AComponent: TComponent;
+        SourceChangeCache: TSourceChangeCache): boolean;
+  
     function GetCompatiblePublishedMethods(const UpperClassName: string;
         TypeData: PTypeData; Proc: TGetStringProc): boolean;
     function GetCompatiblePublishedMethods(ClassNode: TCodeTreeNode;
@@ -193,7 +197,7 @@ begin
     {$ENDIF}
     BuildTree(true);
     if not InterfaceSectionFound then exit;
-    ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
+    ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
     {$IFDEF CTDEBUG}
     writeln('[TEventsCodeTool.GetCompatiblePublishedMethods] B ',ClassNode<>nil);
     {$ENDIF}
@@ -376,7 +380,7 @@ begin
     {$ENDIF}
     BuildTree(true);
     if not InterfaceSectionFound then exit;
-    ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
+    ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
     {$IFDEF CTDEBUG}
     writeln('[TEventsCodeTool.PublishedMethodExists] B ',ClassNode<>nil);
     {$ENDIF}
@@ -474,7 +478,7 @@ var ClassNode: TCodeTreeNode;
 begin
   BuildTree(false);
   if not EndOfSourceFound then exit;
-  ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
+  ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
   Result:=RenamePublishedMethod(ClassNode,UpperOldMethodName,NewMethodName,
                                 SourceChangeCache);
 end;
@@ -527,12 +531,12 @@ end;
 function TEventsCodeTool.CreatePublishedMethod(const UpperClassName,
   AMethodName: string; ATypeInfo: PTypeInfo;
   SourceChangeCache: TSourceChangeCache): boolean;
-var ClassNode: TCodeTreeNode;
+var AClassNode: TCodeTreeNode;
 begin
   BuildTree(false);
   if not EndOfSourceFound then exit;
-  ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
+  AClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
-  Result:=CreatePublishedMethod(ClassNode,AMethodName,ATypeInfo,
+  Result:=CreatePublishedMethod(AClassNode,AMethodName,ATypeInfo,
                SourceChangeCache);
 end;
 
@@ -702,6 +706,68 @@ begin
   Result:=ifrProceedSearch;
 end;
 
+function TEventsCodeTool.CompleteComponent(AComponent: TComponent;
+  SourceChangeCache: TSourceChangeCache): boolean;
+{ - Adds all missing published variable declarations to the class definition
+    in the source
+}
+var
+  UpperClassName: String;
+  i: Integer;
+  CurComponent: TComponent;
+  VarName: String;
+  UpperCurComponentName: String;
+  VarType: String;
+begin
+  Result:=false;
+  BuildTree(false);
+  if not EndOfSourceFound then exit;
+  UpperClassName:=UpperCaseStr(AComponent.ClassName);
+  { $IFDEF CTDEBUG}
+  writeln('[TEventsCodeTool.CompleteComponent] A Component="',AComponent.Name,':',AComponent.ClassName);
+  { $ENDIF}
+  // initialize class for code completion
+  CodeCompleteClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
+  CodeCompleteSrcChgCache:=SourceChangeCache;
+  // complete all child components
+  for i:=0 to AComponent.ComponentCount-1 do begin
+    CurComponent:=AComponent.Components[i];
+    writeln('[TEventsCodeTool.CompleteComponent]  CurComponent=',CurComponent.Name,':',CurComponent.ClassName);
+    VarName:=CurComponent.Name;
+    if VarName='' then continue;
+    UpperCurComponentName:=UpperCaseStr(VarName);
+    VarType:=CurComponent.ClassName;
+    // add missing published variable
+    if VarExistsInCodeCompleteClass(UpperCurComponentName) then begin
+    end else begin
+      writeln('[TEventsCodeTool.CompleteComponent] ADDING variable ',CurComponent.Name,':',CurComponent.ClassName);
+      AddClassInsertion(nil,UpperCurComponentName,
+              VarName+':'+VarType+';',VarName,'',ncpPublishedVars);
+    end;
+    // add missing published events
+    
+    // ToDo
+    
+  end;
+  { $IFDEF CTDEBUG}
+  writeln('[TEventsCodeTool.CompleteComponent] invoke class completion');
+  { $ENDIF}
+  if not InsertAllNewClassParts then
+    RaiseException(ctsErrorDuringInsertingNewClassParts);
+
+  // insert all missing proc bodies
+  if not CreateMissingProcBodies then
+    RaiseException(ctsErrorDuringCreationOfNewProcBodies);
+
+  // apply the changes
+  if not SourceChangeCache.Apply then
+    RaiseException(ctsUnableToApplyChanges);
+  { $IFDEF CTDEBUG}
+  writeln('[TEventsCodeTool.CompleteComponent] END');
+  { $ENDIF}
+  Result:=true;
+end;
+
 function TEventsCodeTool.FindIdentifierNodeInClass(ClassNode: TCodeTreeNode;
   Identifier: PChar): TCodeTreeNode;
 var
@@ -723,7 +789,5 @@ begin
   Result:=nil;
 end;
 
-
-
 end.
 

components/codetools/pascalreadertool.pas

@@ -103,7 +103,7 @@ type
         const UpperClassName: string;
         IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
     function FindClassNodeInInterface(const UpperClassName: string;
-        IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
+        IgnoreForwards, IgnoreNonForwards, ErrorOnNotFound: boolean): TCodeTreeNode;
     function FindFirstIdentNodeInClass(ClassNode: TCodeTreeNode): TCodeTreeNode;
     function ClassSectionNodeStartsWithWord(ANode: TCodeTreeNode): boolean;
 
@@ -943,17 +943,26 @@ begin
 end;
 
 function TPascalReaderTool.FindClassNodeInInterface(
-  const UpperClassName: string; IgnoreForwards, IgnoreNonForwards: boolean
+  const UpperClassName: string; IgnoreForwards, IgnoreNonForwards,
-  ): TCodeTreeNode;
+  ErrorOnNotFound: boolean): TCodeTreeNode;
+  
+  procedure RaiseClassNotFound;
+  begin
+    RaiseExceptionFmt(ctsClassSNotFound, [UpperClassName]);
+  end;
+  
 begin
   Result:=Tree.Root;
-  if Result=nil then exit;
+  if Result<>nil then begin
-  if Result.Desc=ctnUnit then begin
+    if Result.Desc=ctnUnit then begin
-    Result:=Result.NextBrother;
+      Result:=Result.NextBrother;
-    if Result=nil then exit;
+    end;
+    if Result<>nil then
+      Result:=FindClassNode(Result.FirstChild,UpperClassName,
+                   IgnoreForwards, IgnoreNonForwards);
   end;
-  Result:=FindClassNode(Result.FirstChild,UpperClassName,
+  if (Result=nil) and ErrorOnNotFound then
-               IgnoreForwards, IgnoreNonForwards);
+    RaiseClassNotFound;
 end;
 
 function TPascalReaderTool.FindFirstIdentNodeInClass(ClassNode: TCodeTreeNode

components/codetools/stdcodetools.pas

@@ -1136,7 +1136,7 @@ begin
   AncestorClassName:='';
   if UpperClassName='' then exit;
   BuildTree(true);
-  ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
+  ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,false);
   if (ClassNode=nil) then exit;
   // search the ancestor name
   MoveCursorToNodeStart(ClassNode);
@@ -2001,7 +2001,7 @@ begin
   Result:=nil;
   if (UpperClassName='') or (length(UpperClassName)>255) then exit;
   BuildTree(true);
-  ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
+  ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,false);
   if ClassNode=nil then exit;
   BuildSubTreeForClass(ClassNode);
   SectionNode:=ClassNode.FirstChild;
@@ -2034,7 +2034,7 @@ begin
     Result:=true;
     exit;
   end;
-  ClassNode:=FindClassNodeInInterface(UpperClassName,true,false);
+  ClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
   if ClassNode=nil then exit;
   BuildSubTreeForClass(ClassNode);
   SectionNode:=ClassNode.FirstChild;

designer/designer.pp

@@ -148,7 +148,7 @@ type
     PopupMenuComponentEditor: TBaseComponentEditor;
     LastFormCursor: TCursor;
     DeletingComponents: TList;
-    
+
     LastPaintSender: TControl;
 
     // event handlers for designed components
@@ -173,6 +173,8 @@ type
     function DoCopySelectionToClipboard: boolean;
     procedure DoPasteSelectionFromClipboard;
     procedure DoShowTabOrderEditor;
+    procedure GiveComponentsNames;
+    procedure NotifyComponentAdded(AComponent: TComponent);
 
     // popup menu
     procedure BuildPopupMenu;
@@ -214,7 +216,7 @@ type
     procedure PasteSelection;
     procedure DeleteSelection;
     function InvokeComponentEditor(AComponent: TComponent;
-      MenuIndex: integer): boolean;
+                                   MenuIndex: integer): boolean;
     procedure DoProcessCommand(Sender: TObject; var Command: word;
                                var Handled: boolean);
 
@@ -226,13 +228,14 @@ type
     function GetShiftState: TShiftState; override;
 
     procedure AddComponentEditorMenuItems(
-      AComponentEditor: TBaseComponentEditor; AParentMenuItem: TMenuItem);
+            AComponentEditor: TBaseComponentEditor; AParentMenuItem: TMenuItem);
 
     function IsDesignMsg(Sender: TControl;
-       var TheMessage: TLMessage): Boolean; override;
+                                  var TheMessage: TLMessage): Boolean; override;
+    function UniqueName(const BaseName: string): string; override;
     Procedure RemoveComponentAndChilds(AComponent: TComponent);
     procedure Notification(AComponent: TComponent;
-       Operation: TOperation); override;
+                           Operation: TOperation); override;
     procedure ValidateRename(AComponent: TComponent;
        const CurName, NewName: string); override;
     function CreateUniqueComponentName(const AClassName: string): string; override;
@@ -634,8 +637,7 @@ var
       // set new nice bounds
       FindUniquePosition(NewComponent);
       // finish adding component
-      if Assigned(FOnComponentAdded) then
+      NotifyComponentAdded(NewComponent);
-        FOnComponentAdded(Self,NewComponent,nil);
       Modified;
     end;
 
@@ -707,6 +709,31 @@ begin
     Modified;
 end;
 
+procedure TDesigner.GiveComponentsNames;
+var
+  i: Integer;
+  CurComponent: TComponent;
+begin
+  if LookupRoot=nil then exit;
+  for i:=0 to LookupRoot.ComponentCount-1 do begin
+    CurComponent:=LookupRoot.Components[i];
+    if CurComponent.Name='' then
+      CurComponent.Name:=UniqueName(CurComponent.ClassName);
+  end;
+end;
+
+procedure TDesigner.NotifyComponentAdded(AComponent: TComponent);
+begin
+  try
+    GiveComponentsNames;
+    if Assigned(FOnComponentAdded) then
+      FOnComponentAdded(Self,AComponent,nil);
+  except
+    on E: Exception do
+      MessageDlg('Error:',E.Message,mtError,[mbOk],0);
+  end;
+end;
+
 procedure TDesigner.SelectOnlyThisComponent(AComponent:TComponent);
 begin
   ControlSelection.AssignComponent(AComponent);
@@ -1184,13 +1211,7 @@ writeln('AddComponent A ',FLookupRoot is TCustomForm);
       FOnSetDesigning(Self,NewCI.Component,True);
       
     // tell IDE about the new component (e.g. add it to the source)
-    try
+    NotifyComponentAdded(NewCI.Component);
-      if Assigned(FOnComponentAdded) then
-        FOnComponentAdded(Self,NewCI.Component,SelectedCompClass);
-    except
-      on E: Exception do
-        MessageDlg('Error:',E.Message,mtError,[mbOk],0);
-    end;
 
     // creation completed
     // -> select new component
@@ -1200,7 +1221,6 @@ writeln('AddComponent A ',FLookupRoot is TCustomForm);
         // this resets the component palette to the selection tool
         FOnUnselectComponentClass(Self);
         
-    //Form.Invalidate;
     {$IFDEF VerboseDesigner}
     writeln('NEW COMPONENT ADDED: Form.ComponentCount=',Form.ComponentCount,
        '  NewCI.Control.Owner.Name=',NewCI.Component.Owner.Name);
@@ -1562,24 +1582,27 @@ var
   Hook: TPropertyEditorHook;
 begin
   PopupMenuComponentEditor:=nil;
-  if TheFormEditor.FindComponent(AComponent)<>nil then begin
+  if TheFormEditor.FindComponent(AComponent)=nil then begin
-    // unselect component
-    ControlSelection.Remove(AComponent);
-    // call RemoveComponent handler
-    if Assigned(FOnRemoveComponent) then
-      FOnRemoveComponent(Self,AComponent);
-    // call component deleting handlers
-    Hook:=GetPropertyEditorHook;
-    if Hook<>nil then
-      Hook.ComponentDeleting(AComponent);
-    // delete component
-    TheFormEditor.DeleteControl(AComponent,FreeComponent);
     // unmark component
     DeletingComponents.Remove(AComponent);
-    // call ComponentDeleted handler
+    exit;
-    if Assigned(FOnComponentDeleted) then
-      FOnComponentDeleted(Self,AComponent);
   end;
+  // unselect component
+  ControlSelection.Remove(AComponent);
+  // call RemoveComponent handler
+  if Assigned(FOnRemoveComponent) then
+    FOnRemoveComponent(Self,AComponent);
+  // call component deleting handlers
+  Hook:=GetPropertyEditorHook;
+  if Hook<>nil then
+    Hook.ComponentDeleting(AComponent);
+  // delete component
+  TheFormEditor.DeleteControl(AComponent,FreeComponent);
+  // unmark component
+  DeletingComponents.Remove(AComponent);
+  // call ComponentDeleted handler
+  if Assigned(FOnComponentDeleted) then
+    FOnComponentDeleted(Self,AComponent);
 end;
 
 procedure TDesigner.MarkComponentForDeletion(AComponent: TComponent);
@@ -1629,6 +1652,11 @@ Begin
   end;
 end;
 
+function TDesigner.UniqueName(const BaseName: string): string;
+begin
+  Result:=TheFormEditor.CreateUniqueComponentName(BaseName,LookupRoot);
+end;
+
 procedure TDesigner.Modified;
 Begin
   ControlSelection.SaveBounds;

ide/customformeditor.pp

@@ -158,7 +158,6 @@ each control that's dropped onto the form
     function CreateUniqueComponentName(AComponent: TComponent): string;
     function CreateUniqueComponentName(const AClassName: string;
       OwnerComponent: TComponent): string;
-//    Function CreateComponent(CI : TIComponentInterface; TypeName : String;
     Function CreateComponentInterface(AComponent: TComponent): TIComponentInterface;
     Function CreateComponent(ParentCI : TIComponentInterface;
       TypeClass: TComponentClass;  X,Y,W,H : Integer): TIComponentInterface; override;

ide/main.pp

@@ -1073,12 +1073,6 @@ begin
   OpenFilePopUpMenu := TPopupMenu.Create(self);
   OpenFilePopupMenu.Name:='OpenFilePopupMenu';
   OpenFilePopupMenu.AutoPopup := False;
-  {
-    MenuItem := TMenuItem.Create(Self);
-    MenuItem.Caption := 'No files have been opened';
-    MenuItem.OnClick := nil;
-    OpenFilePopupMenu.Items.Add(MenuItem);
-  }
 end;
 
 procedure TMainIDE.SetupComponentNoteBook;
@@ -7313,7 +7307,7 @@ procedure TMainIDE.OnDesignerComponentAdded(Sender: TObject;
 var
   ActiveUnitInfo: TUnitInfo;
   ActiveSrcEdit: TSourceEditor;
-  OwnerClassName: string;
+  ADesigner: TDesigner;
 begin
   if not (Sender is TDesigner) then begin
     writeln('TMainIDE.OnDesignerComponentAdded ERROR: Sender.ClassName=',
@@ -7322,8 +7316,8 @@ begin
   end;
   if AComponentClass=nil then
     AComponentClass:=IDEComponentPalette.FindComponent(AComponent.ClassName);
-  BeginCodeTool(TDesigner(Sender),ActiveSrcEdit,ActiveUnitInfo,
+  ADesigner:=TDesigner(Sender);
-                [ctfSwitchToFormSource]);
+  BeginCodeTool(ADesigner,ActiveSrcEdit,ActiveUnitInfo,[ctfSwitchToFormSource]);
 
   // add needed package to required packages
   PkgBoss.AddProjectRegCompDependency(Project1,AComponentClass);
@@ -7331,15 +7325,8 @@ begin
   CodeToolBoss.AddUnitToMainUsesSection(ActiveUnitInfo.Source,
                                         AComponentClass.GetUnitName,'');
   ActiveUnitInfo.Modified:=true;
-  // add component definition to form source
+  // add component definitions to form source
-  OwnerClassName:=AComponent.Owner.ClassName;
+  CodeToolBoss.CompleteComponent(ActiveUnitInfo.Source,ADesigner.LookupRoot);
-  if not CodeToolBoss.PublishedVariableExists(ActiveUnitInfo.Source,
-    OwnerClassName,AComponent.Name) then begin
-    // ! AddPublishedVariable does not rebuild the CodeTree, so we need
-    // PublishedVariableExists before !
-    CodeToolBoss.AddPublishedVariable(ActiveUnitInfo.Source,OwnerClassName,
-      AComponent.Name, AComponent.ClassName);
-  end;
 
   ObjectInspector1.FillComponentComboBox;
 end;
@@ -8457,12 +8444,16 @@ begin
   if (not IsValidIdent(NewName)) or (NewName='') then
     raise Exception.Create(Format(lisComponentNameIsNotAValidIdentifier, ['"',
       Newname, '"']));
+  if AComponent.Name='' then begin
+    // this component was never added to the source. It is a new component.
+    exit;
+  end;
   BeginCodeTool(ADesigner,ActiveSrcEdit,ActiveUnitInfo,[ctfSwitchToFormSource]);
   ActiveUnitInfo:=Project1.UnitWithComponent(ADesigner.LookupRoot);
   if CodeToolBoss.IsKeyWord(ActiveUnitInfo.Source,NewName) then
     raise Exception.Create(Format(lisComponentNameIsKeyword, ['"', Newname, '"']
       ));
-  if AComponent.Owner<>nil then begin
+  if ADesigner.LookupRoot<>nil then begin
     // rename published variable in form source
     BossResult:=CodeToolBoss.RenamePublishedVariable(ActiveUnitInfo.Source,
       ADesigner.LookupRoot.ClassName,
@@ -9301,6 +9292,9 @@ end.
 
 { =============================================================================
   $Log$
+  Revision 1.616  2003/06/23 12:33:55  mattias
+  implemented TPairSplitter streaming
+
   Revision 1.615  2003/06/23 09:42:09  mattias
   fixes for debugging lazarus
 

images/components_images.lrs

@@ -1094,6 +1094,20 @@ LazarusResources.Add('tpaintbox','XPM',[
   +'     ",'#10'"$&@+$+               ",'#10'"$+%$+                ",'#10'"%%$+'
   +'                 "};'#10
 ]);
+LazarusResources.Add('tpairsplitter','XPM',[
+  '/* XPM */'#10'static char * tpairsplitter_xpm[] = {'#10'"22 22 7 1",'#10'" '
+  +#9'c None",'#10'".'#9'c #E2E2E2",'#10'"+'#9'c #B7B7B7",'#10'"@'#9'c #636363"'
+  +','#10'"#'#9'c #F90000",'#10'"$'#9'c #D30000",'#10'"%'#9'c #930000",'#10'"  '
+  +'                    ",'#10'"                      ",'#10'"        .....    '
+  +'     ",'#10'"        .+++@         ",'#10'"        .+++@         ",'#10'"  '
+  +'      .+++@         ",'#10'"        .+++@         ",'#10'"        .+++@    '
+  +'     ",'#10'"      # .+++@ #       ",'#10'"     #$ .+++@ #$      ",'#10'"  '
+  +'  #$$$$$$$$$$$$     ",'#10'"   #$$$$$$$$$$$$$%    ",'#10'"    $$%%%%%%%%$$%'
+  +'     ",'#10'"     $% .+++@ $%      ",'#10'"      % .+++@ %       ",'#10'"  '
+  +'      .+++@         ",'#10'"        .+++@         ",'#10'"        .+++@    '
+  +'     ",'#10'"        .+++@         ",'#10'"        .+++@         ",'#10'"  '
+  +'      @@@@@         ",'#10'"                      "};'#10
+]);
 LazarusResources.Add('tpanel','XPM',[
   '/* XPM */'#10'static char * tpanel_xpm[] = {'#10'"20 21 4 1",'#10'" '#9'c No'
   +'ne",'#10'".'#9'c #808080",'#10'"+'#9'c #FFFFFF",'#10'"@'#9'c #C0C0C0",'#10

lcl/forms.pp

@@ -784,6 +784,7 @@ type
       const CurName, NewName: string); virtual; abstract;
     function GetShiftState: TShiftState; virtual; abstract;
     Procedure SelectOnlyThisComponent(AComponent:TComponent); virtual; abstract;
+    function UniqueName(const BaseName: string): string; virtual; abstract;
   end;
 
 {$IFNDEF VER1_0_8}

lcl/menus.pp

@@ -311,10 +311,10 @@ implementation
 
 { Menu command managment }
 
-var
+{var
   CommandPool: TBits;
 
-{function UniqueCommand: Word;
+function UniqueCommand: Word;
 begin
   Result := CommandPool.OpenBit;
   CommandPool[Result] := True;
@@ -374,6 +374,9 @@ end.
 
 {
   $Log$
+  Revision 1.46  2003/06/23 12:33:55  mattias
+  implemented TPairSplitter streaming
+
   Revision 1.45  2003/06/23 09:42:09  mattias
   fixes for debugging lazarus
 

lcl/pairsplitter.pas

@@ -35,8 +35,8 @@ unit PairSplitter;
 interface
 
 uses
-  Classes, SysUtils, LCLProc, LMessages, VCLGlobals, Graphics, LCLLinux,
+  Classes, SysUtils, LCLProc, LMessages, VCLGlobals, Graphics, GraphType,
-  Controls;
+  LCLLinux, Controls;
   
 type
   TCustomPairSplitter = class;
@@ -59,7 +59,13 @@ type
   public
     property Splitter: TCustomPairSplitter read GetSplitter;
     property Visible;
+    property Left;
+    property Top;
+    property Width;
+    property Height;
   published
+    property ClientWidth;
+    property ClientHeight;
     property Enabled;
     property OnMouseDown;
     property OnMouseMove;
@@ -125,8 +131,16 @@ type
     property Visible;
   end;
   
+procedure Register;
+  
 implementation
 
+procedure Register;
+begin
+  RegisterComponents('Additional',[TPairSplitter]);
+  RegisterNoIcon([TPairSplitterSide]);
+end;
+
 { TPairSplitterSide }
 
 function TPairSplitterSide.GetSplitter: TCustomPairSplitter;
@@ -176,7 +190,7 @@ begin
     ACanvas := TControlCanvas.Create;
     with ACanvas do begin
       Control := Self;
-      Pen.Color:=clRed;
+      Pen.Style := psDash;
       Frame(0,0,Width-1,Height-1);
       Free;
     end;
@@ -260,8 +274,7 @@ begin
       FSides[i]:=nil;
     end;
   // if the user deletes a side at designtime, autocreate a new one
-  if (csDesigning in ComponentState) and (not (csDestroying in ComponentState))
+  if (csDesigning in ComponentState) then
-  then
     CreateSides;
 end;
 
@@ -271,9 +284,9 @@ begin
   FCompStyle := csPairSplitter;
   ControlStyle:=ControlStyle-[csAcceptsControls];
   FSplitterType:=pstHorizontal;
-  SetInitialBounds(0, 0, 50, 50);
+  SetInitialBounds(0, 0, 90, 90);
-  if not (csLoading in ComponentState) then
+  FPosition:=45;
-    CreateSides;
+  CreateSides;
 end;
 
 destructor TCustomPairSplitter.Destroy;
@@ -291,12 +304,16 @@ end;
 procedure TCustomPairSplitter.CreateWnd;
 var
   i: Integer;
+  APosition: Integer;
 begin
   inherited CreateWnd;
   for i:=Low(FSides) to High(FSides) do
     if FSides[i]<>nil then
       PairSplitterAddSide(Handle,FSides[i].Handle,i);
-  PairSplitterSetPosition(Handle,FPosition);
+  APosition:=FPosition;
+  PairSplitterSetPosition(Handle,APosition);
+  if not (csLoading in ComponentState) then
+    FPosition:=APosition;
 end;
 
 procedure TCustomPairSplitter.UpdatePosition;
@@ -315,16 +332,15 @@ var
   ASide: TPairSplitterSide;
   i: Integer;
 begin
-  if fDoNotCreateSides then exit;
+  if fDoNotCreateSides or (csDestroying in ComponentState)
+  or (csLoading in ComponentState)
+  or ((Owner<>nil) and (csLoading in Owner.ComponentState)) then exit;
   // create the missing side controls
   for i:=Low(FSides) to High(FSides) do
     if FSides[i]=nil then begin
       // For streaming it is important that the side controls are owned by
       // the owner of the splitter
-      if (Owner<>nil) then
+      ASide:=TPairSplitterSide.Create(Owner);
-        ASide:=TPairSplitterSide.Create(Owner)
-      else
-        ASide:=TPairSplitterSide.Create(Self);
       ASide.fCreatedBySplitter:=true;
       ASide.Parent:=Self;
     end;
@@ -334,6 +350,8 @@ procedure TCustomPairSplitter.Loaded;
 begin
   inherited Loaded;
   CreateSides;
+  if HandleAllocated then
+    PairSplitterSetPosition(Handle,FPosition);
 end;
 
 end.

packager/packagesystem.pas

@@ -877,6 +877,7 @@ begin
     AddFile('spin.pp','Spin',pftUnit,[pffHasRegisterProc],cpBase);
     AddFile('arrow.pp','Arrow',pftUnit,[pffHasRegisterProc],cpBase);
     AddFile('calendar.pp','Calendar',pftUnit,[pffHasRegisterProc],cpBase);
+    AddFile('pairsplitter.pas','PairSplitter',pftUnit,[pffHasRegisterProc],cpBase);
     // increase priority by one, so that the LCL components are inserted to the
     // left in the palette
     for i:=0 to FileCount-1 do

packager/registerlcl.pas

@@ -40,7 +40,7 @@ interface
 uses
   LazarusPackageIntf,
   Menus, Buttons, StdCtrls, ExtCtrls, ComCtrls, Forms, Grids, Controls,
-  Dialogs, Spin, Arrow, Calendar, MaskEdit, CheckLst;
+  Dialogs, Spin, Arrow, Calendar, MaskEdit, CheckLst, PairSplitter;
   
 procedure Register;
 
@@ -62,6 +62,7 @@ begin
   RegisterUnit('Spin',@Spin.Register);
   RegisterUnit('Arrow',@Arrow.Register);
   RegisterUnit('Calendar',@Calendar.Register);
+  RegisterUnit('PairSplitter',@PairSplitter.Register);
 end;
 
 end.