fixed not turning visible on designed forms

git-svn-id: trunk@8106 -
2025-08-19 04:02:11 +02:00 · 2005-11-08 18:05:12 +00:00 · 2005-11-08 18:05:12 +00:00 · 4ff395608a
commit 4ff395608a
parent 4886371312
9 changed files with 167 additions and 40 deletions
--- a/components/codetools/codetemplatestool.pas
+++ b/components/codetools/codetemplatestool.pas
@ -40,7 +40,7 @@ uses
  {$ENDIF}
  Classes, SysUtils, CodeTree, CodeAtom, KeywordFuncLists, BasicCodeTools,
  LinkScanner, AVL_Tree, SourceChanger,
-  CustomCodeTool, CodeToolsStructs, StdCodeTools;
+  CustomCodeTool, PascalParserTool, CodeToolsStructs, StdCodeTools;

 type
  TCodeTemplateSyntax = (
@ -110,12 +110,16 @@ type
    property Indent: integer read FIndent write SetIndent;
  end;

+  { TCodeTemplatesTool }
+
  TCodeTemplatesTool = class(TStandardCodeTool)
  public
    function InsertCodeTemplate(CursorPos,EndPos: TCodeXYPosition;
      TopLine: integer; CodeTemplate: TCodeToolTemplate;
      var NewPos: TCodeXYPosition; var NewTopLine: integer;
      SourceChangeCache: TSourceChangeCache): boolean;
+    function ExtractProcedureHeader(CursorPos: TCodeXYPosition;
+      Attributes: TProcHeadAttributes; var ProcHead: string): boolean;
  end;

 implementation
@ -249,6 +253,23 @@ begin
  end;
 end;

+function TCodeTemplatesTool.ExtractProcedureHeader(CursorPos: TCodeXYPosition;
+  Attributes: TProcHeadAttributes; var ProcHead: string): boolean;
+var
+  CleanCursorPos: integer;
+  ANode: TCodeTreeNode;
+begin
+  Result:=false;
+  ProcHead:='';
+  BuildTreeAndGetCleanPos(trTillCursor,CursorPos,CleanCursorPos,[]);
+  ANode:=FindDeepestNodeAtPos(CleanCursorPos,True);
+  while (ANode<>nil) and (ANode.Desc<>ctnProcedure) do
+    ANode:=ANode.Parent;
+  if ANode=nil then exit;
+  ProcHead:=ExtractProcHead(ANode,Attributes);
+  Result:=true;
+end;
+
 { TCodeToolTemplate }

 procedure TCodeToolTemplate.SetIndent(const AValue: integer);
--- a/components/codetools/codetoolmanager.pas
+++ b/components/codetools/codetoolmanager.pas
@ -43,7 +43,7 @@ uses
  Classes, SysUtils, FileProcs, BasicCodeTools, CodeToolsStrConsts,
  EventCodeTool, CodeTree, CodeAtom, SourceChanger, DefineTemplates, CodeCache,
  ExprEval, LinkScanner, KeywordFuncLists, TypInfo,
-  AVL_Tree, LFMTrees,
+  AVL_Tree, LFMTrees, PascalParserTool,
  CustomCodeTool, FindDeclarationTool, IdentCompletionTool, StdCodeTools,
  ResourceCodeTool, CodeToolsStructs, CodeTemplatesTool, ExtractProcTool;

@ -303,8 +303,8 @@ type
          var NewX, NewY, NewTopLine: integer): boolean;

    // get code context
-    //function FindCodeContext(Code: TCodeBuffer; X,Y: integer;
-    //      out CodeContext: TCodeContext): boolean;
+    function ExtractProcedureHeader(Code: TCodeBuffer; X,Y: integer;
+          Attributes: TProcHeadAttributes; var ProcHead: string): boolean;

    // gather identifiers (i.e. all visible)
    function GatherIdentifiers(Code: TCodeBuffer; X,Y: integer): boolean;
@ -360,7 +360,7 @@ type
          var NewCode: TCodeBuffer;
          var NewX, NewY, NewTopLine: integer): boolean;
          
-    // extract proc
+    // extract proc (creates a new procedure from code in selection)
    function CheckExtractProc(Code: TCodeBuffer;
          const StartPoint, EndPoint: TPoint;
          var MethodPossible, SubProcSameLvlPossible: boolean): boolean;
@ -1433,6 +1433,29 @@ begin
  {$ENDIF}
 end;

+function TCodeToolManager.ExtractProcedureHeader(Code: TCodeBuffer; X,
+  Y: integer; Attributes: TProcHeadAttributes; var ProcHead: string): boolean;
+var
+  CursorPos: TCodeXYPosition;
+begin
+  Result:=false;
+  {$IFDEF CTDEBUG}
+  DebugLn('TCodeToolManager.ExtractProcedureHeader A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
+  {$ENDIF}
+  if not InitCurCodeTool(Code) then exit;
+  CursorPos.X:=X;
+  CursorPos.Y:=Y;
+  CursorPos.Code:=Code;
+  try
+    Result:=FCurCodeTool.ExtractProcedureHeader(CursorPos,Attributes,ProcHead);
+  except
+    on e: Exception do HandleException(e);
+  end;
+  {$IFDEF CTDEBUG}
+  DebugLn('TCodeToolManager.GatherIdentifiers END ');
+  {$ENDIF}
+end;
+
 function TCodeToolManager.GatherIdentifiers(Code: TCodeBuffer; X, Y: integer
  ): boolean;
 var
--- a/ide/codemacroselect.lfm
+++ b/ide/codemacroselect.lfm
@ -5,7 +5,7 @@ object CodeMacroSelectDlg: TCodeMacroSelectDlg
  ClientWidth = 560
  OnClose = FormClose
  OnCreate = FormCreate
-  PixelsPerInch = 75
+  PixelsPerInch = 112
  HorzScrollBar.Page = 559
  VertScrollBar.Page = 274
  Left = 318
@ -41,13 +41,13 @@ object CodeMacroSelectDlg: TCodeMacroSelectDlg
    Height = 215
    Top = 10
    Width = 360
-    object DescriptionLabel: TLabel
+    object DescriptionMemo: TMemo
      Align = alClient
-      AutoSize = False
-      Caption = 'DescriptionLabel'
-      Color = clNone
-      ParentColor = False
-      WordWrap = True
+      Lines.Strings = (
+        'Memo1'
+      )
+      ReadOnly = True
+      TabOrder = 0
      Height = 198
      Width = 356
    end
--- a/ide/codemacroselect.lrs
+++ b/ide/codemacroselect.lrs
@ -4,7 +4,7 @@ LazarusResources.Add('TCodeMacroSelectDlg','FORMDATA',[
  'TPF0'#19'TCodeMacroSelectDlg'#18'CodeMacroSelectDlg'#13'ActiveControl'#7#13
  +'MacrosListBox'#7'Caption'#6#18'CodeMacroSelectDlg'#12'ClientHeight'#3#19#1
  +#11'ClientWidth'#3'0'#2#7'OnClose'#7#9'FormClose'#8'OnCreate'#7#10'FormCreat'
-  +'e'#13'PixelsPerInch'#2'K'#18'HorzScrollBar.Page'#3'/'#2#18'VertScrollBar.Pa'
+  +'e'#13'PixelsPerInch'#2'p'#18'HorzScrollBar.Page'#3'/'#2#18'VertScrollBar.Pa'
  +'ge'#3#18#1#4'Left'#3'>'#1#6'Height'#3#19#1#3'Top'#3#200#0#5'Width'#3'0'#2#0
  +#9'TGroupBox'#14'MacrosGroupBox'#7'Anchors'#11#5'akTop'#6'akLeft'#8'akBottom'
  +#0#7'Caption'#6#14'MacrosGroupBox'#12'ClientHeight'#3#198#0#11'ClientWidth'#3
@ -14,16 +14,16 @@ LazarusResources.Add('TCodeMacroSelectDlg','FORMDATA',[
  +#6'Height'#3#198#0#5'Width'#3#166#0#0#0#0#9'TGroupBox'#19'DescriptionGroupBo'
  +'x'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#7'Caption'#6#19
  +'DescriptionGroupBox'#12'ClientHeight'#3#198#0#11'ClientWidth'#3'd'#1#8'TabO'
-  +'rder'#2#1#4'Left'#3#190#0#6'Height'#3#215#0#3'Top'#2#10#5'Width'#3'h'#1#0#6
-  +'TLabel'#16'DescriptionLabel'#5'Align'#7#8'alClient'#8'AutoSize'#8#7'Caption'
-  +#6#16'DescriptionLabel'#5'Color'#7#6'clNone'#11'ParentColor'#8#8'WordWrap'#9
-  +#6'Height'#3#198#0#5'Width'#3'd'#1#0#0#0#7'TButton'#8'OkButton'#7'Anchors'#11
-  +#5'akTop'#7'akRight'#0#8'AutoSize'#9#19'BorderSpacing.Right'#2#10#25'BorderS'
-  +'pacing.InnerBorder'#2#2#7'Caption'#6#8'OkButton'#11'ModalResult'#2#1#8'TabO'
-  +'rder'#2#2#21'AnchorSideTop.Control'#7#12'CancelButton'#18'AnchorSideTop.Sid'
-  +'e'#7#9'asrCenter'#23'AnchorSideRight.Control'#7#12'CancelButton'#4'Left'#3
-  +#138#1#6'Height'#2#26#3'Top'#3#235#0#5'Width'#2'='#0#0#7'TButton'#12'CancelB'
-  +'utton'#7'Anchors'#11#7'akRight'#8'akBottom'#0#8'AutoSize'#9#25'BorderSpacin'
-  +'g.InnerBorder'#2#2#7'Caption'#6#12'CancelButton'#11'ModalResult'#2#2#8'TabO'
-  +'rder'#2#3#4'Left'#3#209#1#6'Height'#2#26#3'Top'#3#235#0#5'Width'#2'U'#0#0#0
+  +'rder'#2#1#4'Left'#3#190#0#6'Height'#3#215#0#3'Top'#2#10#5'Width'#3'h'#1#0#5
+  +'TMemo'#15'DescriptionMemo'#5'Align'#7#8'alClient'#13'Lines.Strings'#1#6#5'M'
+  +'emo1'#0#8'ReadOnly'#9#8'TabOrder'#2#0#6'Height'#3#198#0#5'Width'#3'd'#1#0#0
+  +#0#7'TButton'#8'OkButton'#7'Anchors'#11#5'akTop'#7'akRight'#0#8'AutoSize'#9
+  +#19'BorderSpacing.Right'#2#10#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6
+  +#8'OkButton'#11'ModalResult'#2#1#8'TabOrder'#2#2#21'AnchorSideTop.Control'#7
+  +#12'CancelButton'#18'AnchorSideTop.Side'#7#9'asrCenter'#23'AnchorSideRight.C'
+  +'ontrol'#7#12'CancelButton'#4'Left'#3#138#1#6'Height'#2#26#3'Top'#3#235#0#5
+  +'Width'#2'='#0#0#7'TButton'#12'CancelButton'#7'Anchors'#11#7'akRight'#8'akBo'
+  +'ttom'#0#8'AutoSize'#9#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#12'Can'
+  +'celButton'#11'ModalResult'#2#2#8'TabOrder'#2#3#4'Left'#3#209#1#6'Height'#2
+  +#26#3'Top'#3#235#0#5'Width'#2'U'#0#0#0
 ]);
--- a/ide/codemacroselect.pas
+++ b/ide/codemacroselect.pas
@ -39,8 +39,8 @@ type
  { TCodeMacroSelectDlg }

  TCodeMacroSelectDlg = class(TForm)
-    DescriptionLabel: TLabel;
    MacrosListBox: TListBox;
+    DescriptionMemo: TMemo;
    OkButton: TButton;
    CancelButton: TButton;
    MacrosGroupBox: TGroupBox;
@ -108,9 +108,9 @@ begin
    FSelected:=nil;
  end;
  if FSelected<>nil then begin
-    DescriptionLabel.Caption:=FSelected.LongDescription;
+    DescriptionMemo.Text:=FSelected.LongDescription;
  end else begin
-    DescriptionLabel.Caption:=lisCTPleaseSelectAMacro;
+    DescriptionMemo.Text:=lisCTPleaseSelectAMacro;
  end;
 end;

--- a/ide/codetemplatesdlg.pas
+++ b/ide/codetemplatesdlg.pas
@ -33,9 +33,10 @@ interface
 uses
  Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
  ClipBrd, StdCtrls, Buttons, ExtCtrls, Menus,
-  SynEdit, SynHighlighterPas, SynEditAutoComplete,
-  IDECommands, TextTools, SrcEditorIntf, MenuIntf, IDEWindowIntf,
-  InputHistory, LazarusIDEStrConsts, EditorOptions, CodeMacroSelect;
+  SynEdit, SynHighlighterPas, SynEditAutoComplete, CodeToolManager, CodeCache,
+  PascalParserTool,
+  IDECommands, TextTools, SrcEditorIntf, MenuIntf, IDEWindowIntf, LazIDEIntf,
+  IDEProcs, InputHistory, LazarusIDEStrConsts, EditorOptions, CodeMacroSelect;

 type

@ -242,7 +243,76 @@ end;
 function CodeMakroProcedureHead(const Parameter: string;
  InteractiveValue: TPersistent; SrcEdit: TSourceEditorInterface; var Value,
  ErrorMsg: string): boolean;
+var
+  Params: TStringList;
+  Param: string;
+  i: Integer;
+  Attributes: TProcHeadAttributes;
 begin
+  // parse attributes
+  Params:=SplitString(Parameter,',');
+  try
+    Attributes:=[];
+    for i:=0 to Params.Count-1 do begin
+      Param:=Params[i];
+      if CompareText(Param,'WithStart')=0 then
+        Include(Attributes,phpWithStart)
+      else if CompareText(Param,'WithStart')=0 then
+        Include(Attributes,phpWithStart)
+      else if CompareText(Param,'WithoutClassKeyword')=0 then
+        Include(Attributes,phpWithoutClassKeyword)
+      else if CompareText(Param,'AddClassName')=0 then
+        Include(Attributes,phpAddClassName)
+      else if CompareText(Param,'WithoutClassName')=0 then
+        Include(Attributes,phpWithoutClassName)
+      else if CompareText(Param,'WithoutName')=0 then
+        Include(Attributes,phpWithoutName)
+      else if CompareText(Param,'WithoutParamList')=0 then
+        Include(Attributes,phpWithoutParamList)
+      else if CompareText(Param,'WithVarModifiers')=0 then
+        Include(Attributes,phpWithVarModifiers)
+      else if CompareText(Param,'WithParameterNames')=0 then
+        Include(Attributes,phpWithParameterNames)
+      else if CompareText(Param,'WithoutParamTypes')=0 then
+        Include(Attributes,phpWithoutParamTypes)
+      else if CompareText(Param,'WithDefaultValues')=0 then
+        Include(Attributes,phpWithDefaultValues)
+      else if CompareText(Param,'WithResultType')=0 then
+        Include(Attributes,phpWithResultType)
+      else if CompareText(Param,'WithOfObject')=0 then
+        Include(Attributes,phpWithOfObject)
+      else if CompareText(Param,'WithCallingSpecs')=0 then
+        Include(Attributes,phpWithCallingSpecs)
+      else if CompareText(Param,'WithProcModifiers')=0 then
+        Include(Attributes,phpWithProcModifiers)
+      else if CompareText(Param,'WithComments')=0 then
+        Include(Attributes,phpWithComments)
+      else if CompareText(Param,'InUpperCase')=0 then
+        Include(Attributes,phpInUpperCase)
+      else if CompareText(Param,'CommentsToSpace')=0 then
+        Include(Attributes,phpCommentsToSpace)
+      else if CompareText(Param,'WithoutBrackets')=0 then
+        Include(Attributes,phpWithoutBrackets)
+      else begin
+        Result:=false;
+        ErrorMsg:='Unknown Option: "'+Param+'"';
+        exit;
+      end;
+    end;
+
+  finally
+    Params.Free;
+  end;
+
+  if not CodeToolBoss.ExtractProcedureHeader(
+    SrcEdit.CodeToolsBuffer as TCodeBuffer,
+    SrcEdit.CursorTextXY.X,SrcEdit.CursorTextXY.Y,Attributes,Value) then
+  begin
+    Result:=false;
+    ErrorMsg:=CodeToolBoss.ErrorMessage;
+    LazarusIDE.DoJumpToCodeToolBossError;
+    exit;
+  end;

  Result:=true;
 end;
@ -273,8 +343,9 @@ begin
                    'Paste text from clipboard',
                    @CodeMakroPaste,nil);
  RegisterCodeMacro('ProcedureHead','insert procedure head',
-                    'Insert header of current procedure'#13
-                    +'Optional Parameters (comma separated):'#13
+     'Insert header of current procedure'#13
+    +#13
+    +'Optional Parameters (comma separated):'#13
    +'WithStart,          // proc keyword e.g. ''function'', ''class procedure'''#13
    +'WithoutClassKeyword,// without ''class'' proc keyword'#13
    +'AddClassName,       // extract/add ClassName.'#13
@ -296,7 +367,7 @@ begin
    +'                      //    e.g ''Do   ;'' normally becomes ''Do;'''#13
    +'                      //    with this option you get ''Do ;'')'#13
    +'WithoutBrackets,    // skip start- and end-bracket of parameter list'#13,
-                    @CodeMakroPaste,nil);
+    @CodeMakroPaste,nil);
 end;

 { TCodeTemplateEditForm }
--- a/ide/main.pp
+++ b/ide/main.pp
@ -124,10 +124,8 @@ type
  TMainIDE = class(TMainIDEBase)
    // event handlers

-    //procedure FormShow(Sender: TObject);
    procedure MainIDEFormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure MainIDEFormCloseQuery(Sender: TObject; var CanClose: boolean);
-    //procedure FormPaint(Sender: TObject);
    procedure OnApplicationUserInput(Sender: TObject; Msg: Cardinal);
    procedure OnApplicationIdle(Sender: TObject);
    procedure OnApplicationActivate(Sender: TObject);
@ -4509,11 +4507,12 @@ begin
        exit;
      end else begin
        NewComponent:=CInterface.Component;
-        //DebugLn('SUCCESS: streaming lfm="',LFMBuf.Filename,'"');
+        DebugLn('SUCCESS: streaming lfm="',LFMBuf.Filename,'"');
        AnUnitInfo.Component:=NewComponent;
        CreateDesignerForComponent(NewComponent);
        AnUnitInfo.ComponentName:=NewComponent.Name;
        AnUnitInfo.ComponentResourceName:=AnUnitInfo.ComponentName;
+        DesignerForm:=FormEditor1.GetDesignerForm(AnUnitInfo.Component);

        if not (ofProjectLoading in Flags) then begin
          FDisplayState:= dsForm;
@ -4529,7 +4528,7 @@ begin
      end;
    end;
    {$IFDEF IDE_DEBUG}
-    writeln('[TMainIDE.DoLoadLFM] LFM end');
+    debugln('[TMainIDE.DoLoadLFM] LFM end');
    {$ENDIF}
  finally
    BinLFMStream.Free;
@ -4635,6 +4634,8 @@ begin
  if (AForm=nil) then exit;
  if FLastFormActivated=AForm then
    FLastFormActivated:=nil;
+  //debugln('TMainIDE.CloseDesignerForm A ',AnUnitInfo.Filename,' ',dbgsName(LookupRoot));
+    
  // unselect components
  for i:=LookupRoot.ComponentCount-1 downto 0 do
    TheControlSelection.Remove(LookupRoot.Components[i]);
--- a/ide/project.pp
+++ b/ide/project.pp
@ -1490,6 +1490,8 @@ var
  OldProjectType: TOldProjectType;
  xmlconfig: TXMLConfig;
  SourceDirectoriesUpdated: Boolean;
+  SubPath: String;
+  NewUnitFilename: String;

  procedure LoadCompilerOptions;
  var
@ -1602,10 +1604,18 @@ begin
      SourceDirectoriesUpdated:=false;
      NewUnitCount:=xmlconfig.GetValue(Path+'Units/Count',0);
      for i := 0 to NewUnitCount - 1 do begin
+        SubPath:=Path+'Units/Unit'+IntToStr(i)+'/';
+        NewUnitFilename:=XMLConfig.GetValue(SubPath+'Filename/Value','');
+        OnLoadSaveFilename(NewUnitFilename,true);
+        if IndexOfFilename(NewUnitFilename)>=0 then begin
+          // Doppelganger -> inconsistency found, ignore this file
+          debugln('TProject.ReadProject file exists twice in lpi file: ignoring "'+NewUnitFilename+'"');
+          continue;
+        end;
+
        NewUnitInfo:=TUnitInfo.Create(nil);
        AddFile(NewUnitInfo,false);
-        NewUnitInfo.LoadFromXMLConfig(
-           xmlconfig,Path+'Units/Unit'+IntToStr(i)+'/');
+        NewUnitInfo.LoadFromXMLConfig(xmlconfig,SubPath);
      end;
      UpdateSourceDirectories;
      SourceDirectoriesUpdated:=true;
--- a/packager/pkgmanager.pas
+++ b/packager/pkgmanager.pas
@ -2403,6 +2403,7 @@ begin
  Result:=mrOk;
  MissingUnits:=PackageGraph.FindNotInstalledRegisterUnits(nil,
                                              AProject.FirstRequiredDependency);
+  debugln('');
  if MissingUnits<>nil then begin
    Msg:=Format(lisProbablyYouNeedToInstallSomePackagesForBeforeConti, [#13,
      #13, #13, #13, #13, #13, #13, #13, #13]);