identifer completion: implemented adding complete method declaration in class contexts

git-svn-id: trunk@9969 -

components/codetools/finddeclarationtool.pas

@@ -104,7 +104,8 @@ type
     vatRoundBracketClose,// )
     vatEdgedBracketOpen, // [
     vatEdgedBracketClose,// ]
-    vatAddrOp            // @
+    vatAddrOp,           // @
+    vatKeyword           // other keywords
     );
     
 const
@@ -122,7 +123,8 @@ const
      'Bracket)',
      'Bracket[',
      'Bracket]',
-     'AddrOperator@ '
+     'AddrOperator@ ',
+     'Keyword'
      );
      
 type
@@ -4829,6 +4831,10 @@ begin
       Result:=CurAtom.StartPos;
       exit;
     end;
+    if CurAtomType in [vatAS,vatKeyword] then begin
+      Result:=NextAtom.StartPos;
+      exit;
+    end;
     if (not (CurAtomType in [vatIdentifier,vatPreDefIdentifier,vatPoint,vatUp,
       vatEdgedBracketClose,vatRoundBracketClose]))
     or ((CurAtomType in [vatIdentifier,vatPreDefIdentifier,vatNone])
@@ -6481,12 +6487,22 @@ function TFindDeclarationTool.GetCurrentAtomType: TVariableAtomType;
 begin
   if (CurPos.StartPos=CurPos.EndPos) then
     Result:=vatSpace
-  else if WordIsPredefinedIdentifier.DoItUpperCase(UpperSrc,CurPos.StartPos,
-    CurPos.EndPos-CurPos.StartPos)
-  then
-    Result:=vatPreDefIdentifier
-  else if AtomIsIdentifier(false) then
-    Result:=vatIdentifier
+  else if (CurPos.StartPos>SrcLen) then
+    Result:=vatNone
+  else if IsIdentStartChar[UpperSrc[CurPos.StartPos]] then begin
+    if WordIsPredefinedIdentifier.DoItUpperCase(UpperSrc,CurPos.StartPos,
+      CurPos.EndPos-CurPos.StartPos) then
+      Result:=vatPreDefIdentifier
+    else if UpAtomIs('INHERITED') then
+      Result:=vatINHERITED
+    else if UpAtomIs('AS') then
+      Result:=vatAS
+    else if WordIsKeyWord.DoItUpperCase(UpperSrc,CurPos.StartPos,
+             CurPos.EndPos-CurPos.StartPos) then
+      Result:=vatKeyWord
+    else
+      Result:=vatIdentifier;
+  end
   else if (CurPos.StartPos>=1) and (CurPos.StartPos<=SrcLen)
   and (CurPos.StartPos=CurPos.EndPos-1) then begin
     case Src[CurPos.StartPos] of
@@ -6500,10 +6516,6 @@ begin
     else Result:=vatNone;
     end;
   end
-  else if UpAtomIs('INHERITED') then
-    Result:=vatINHERITED
-  else if UpAtomIs('AS') then
-    Result:=vatAS
   else
     Result:=vatNone;
 end;

components/codetools/identcompletiontool.pas

@@ -126,10 +126,11 @@ type
   TIdentifierListFlags = set of TIdentifierListFlag;
   
   TIdentifierListContextFlag = (
-    ilcfStartInStatement, // context starts in statements. e.g. between begin..end
-    ilcfStartIsLValue,    // position is start of one statement. e.g. 'A:='
-    ilcfNeedsEndSemicolon,// after context a semicolon is needed. e.g. 'A end'
-    ilcfIsExpression      // is expression part of statement. e.g. 'if expr'
+    ilcfStartInStatement,  // context starts in statements. e.g. between begin..end
+    ilcfStartIsLValue,     // position is start of one statement. e.g. 'A:='
+    ilcfNeedsEndSemicolon, // after context a semicolon is needed. e.g. 'A end'
+    ilcfIsExpression,      // is expression part of statement. e.g. 'if expr'
+    ilcfCanProcDeclaration // context allows to declarae a procedure/method
     );
   TIdentifierListContextFlags = set of TIdentifierListContextFlag;
   
@@ -1190,6 +1191,7 @@ begin
     GatherContext.Node:=GatherContext.Node.Parent;
 
   StartInSubContext:=false;
+  //DebugLn(['TIdentCompletionTool.FindCollectionContext ContextExprStartPos=',ContextExprStartPos,' "',dbgstr(copy(Src,ContextExprStartPos,20)),'" IdentStartPos="',dbgstr(copy(Src,IdentStartPos,20)),'"']);
   if ContextExprStartPos<IdentStartPos then begin
     MoveCursorToCleanPos(IdentStartPos);
     Params.ContextNode:=CursorNode;
@@ -1198,6 +1200,7 @@ begin
                    fdfSearchInParentNodes,fdfSearchInAncestors];
     ExprType:=FindExpressionTypeOfVariable(ContextExprStartPos,IdentStartPos,
                                            Params);
+    //DebugLn(['TIdentCompletionTool.FindCollectionContext ',ExprTypeToString(ExprType)]);
     if (ExprType.Desc=xtContext) then begin
       GatherContext:=ExprType.Context;
       StartInSubContext:=true;
@@ -1250,6 +1253,21 @@ var
   ContextExprStartPos: Integer;
   StartInSubContext: Boolean;
   StartPosOfVariable: LongInt;
+  
+  procedure CheckProcedureDeclarationContext;
+  var
+    Node: TCodeTreeNode;
+  begin
+    Node:=GatherContext.Node;
+    if Node.Desc in (AllClassSections+AllSourceTypes
+                     +[ctnInterface,ctnImplementation])
+    then begin
+      //DebugLn(['TIdentCompletionTool.CheckProcedureDeclarationContext ilcfCanProcDeclaration']);
+      CurrentIdentifierList.ContextFlags:=
+        CurrentIdentifierList.ContextFlags+[ilcfCanProcDeclaration];
+    end;
+  end;
+  
 begin
   Result:=false;
 
@@ -1277,7 +1295,7 @@ begin
       FindContextClassAndAncestors(CursorPos,ClassAndAncestors);
 
       FindCollectionContext(Params,IdentStartPos,CursorNode,
-        GatherContext,ContextExprStartPos,StartInSubContext);
+                           GatherContext,ContextExprStartPos,StartInSubContext);
 
       // search and gather identifiers in context
       if (GatherContext.Tool<>nil) and (GatherContext.Node<>nil) then begin
@@ -1310,6 +1328,9 @@ begin
 
       // check for incomplete context
       
+      // check for procedure/method declaration context
+      CheckProcedureDeclarationContext;
+
       // context bracket level
       CurrentIdentifierList.StartBracketLvl:=
         GetBracketLvl(Src,CursorNode.StartPos,IdentStartPos,

components/codetools/keywordfunclists.pas

@@ -756,9 +756,11 @@ begin
   WordIsKeyWord:=TKeyWordFunctionList.Create;
   KeyWordLists.Add(WordIsKeyWord);
   with WordIsKeyWord do begin
-    Add('AS',{$ifdef FPC}@{$endif}AllwaysTrue);
+    //Add('ON',{$ifdef FPC}@{$endif}AllwaysTrue); // not for Delphi
+    //Add('OUT',{$ifdef FPC}@{$endif}AllwaysTrue); // not in MacPas mode
     Add('AND',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('ARRAY',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('AS',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('ASM',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('BEGIN',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('CASE',{$ifdef FPC}@{$endif}AllwaysTrue);
@@ -781,8 +783,8 @@ begin
     Add('IF',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('IMPLEMENTATION',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('IN',{$ifdef FPC}@{$endif}AllwaysTrue);
-    Add('INITIALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('INHERITED',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('INITIALIZATION',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('INLINE',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('INTERFACE',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('IS',{$ifdef FPC}@{$endif}AllwaysTrue);
@@ -794,21 +796,24 @@ begin
     Add('OBJECT',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('OF',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('OPERATOR',{$ifdef FPC}@{$endif}AllwaysTrue); // not for Delphi
-    //Add('ON',{$ifdef FPC}@{$endif}AllwaysTrue); // not for Delphi
-    //Add('OUT',{$ifdef FPC}@{$endif}AllwaysTrue); // not in MacPas mode
     Add('OR',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('PACKED',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PRIVATE',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('PROCEDURE',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('PROGRAM',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('PROPERTY',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PROTECTED',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PUBLIC',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('PUBLISHED',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('RAISE',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('RECORD',{$ifdef FPC}@{$endif}AllwaysTrue);
-    Add('RESOURCESTRING',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('REPEAT',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('RESOURCESTRING',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('SET',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('SHL',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('SHR',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('THEN',{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('THREADVAR',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('TO',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('TRY',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('TYPE',{$ifdef FPC}@{$endif}AllwaysTrue);
@@ -816,7 +821,6 @@ begin
     Add('UNTIL',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('USES',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('VAR',{$ifdef FPC}@{$endif}AllwaysTrue);
-    Add('THREADVAR',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('WHILE',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('WITH',{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('XOR',{$ifdef FPC}@{$endif}AllwaysTrue);

components/codetools/pascalreadertool.pas

@@ -453,6 +453,11 @@ begin
 
   // copy memorystream to Result string
   Result:=GetExtraction;
+  
+  // add semicolon
+  if (not (phpWithoutSemicolon in Attr))
+  and (Result<>'') and (Result[length(Result)]<>';') then
+    Result:=Result+';';
 end;
 
 function TPascalReaderTool.ExtractClassName(ClassNode: TCodeTreeNode;

ide/sourceeditprocs.pas

@@ -37,7 +37,7 @@ uses
   Classes, SysUtils, LCLProc, LCLType, GraphType, Graphics, Controls,
   SynEdit, SynRegExpr, SynCompletion,
   BasicCodeTools, CodeTree, CodeCache, CodeToolManager, PascalParserTool,
-  FileProcs, IdentCompletionTool,
+  KeywordFuncLists, FileProcs, IdentCompletionTool,
   LazIDEIntf, TextTools, IDETextConverter,
   DialogProcs, MainIntf, EditorOptions, CodeToolsOptions;
 
@@ -59,7 +59,11 @@ type
   TCompletionType = (
     ctNone, ctWordCompletion, ctTemplateCompletion, ctIdentCompletion);
   TIdentComplValue = (
-    icvIdentifier, icvProcWithParams, icvIndexedProp);
+    icvIdentifier,
+    icvProcWithParams,
+    icvIndexedProp,
+    icvCompleteProcDeclaration
+    );
 
 // completion form and functions
 function PaintCompletionItem(const AKey: string; ACanvas: TCanvas;
@@ -369,6 +373,7 @@ var
   IdentItem: TIdentifierListItem;
   IdentList: TIdentifierList;
   CursorAtEnd: boolean;
+  ProcModifierPos: LongInt;
 begin
   Result:='';
   CursorToLeft:=0;
@@ -387,10 +392,15 @@ begin
 
   Result:=GetIdentifier(IdentItem.Identifier);
 
+  //DebugLn(['GetIdentCompletionValue ',NodeDescriptionAsString(IdentItem.GetDesc)]);
   case IdentItem.GetDesc of
 
     ctnProcedure:
-      if IdentItem.IsProcNodeWithParams then
+      if (ilcfCanProcDeclaration in IdentList.ContextFlags)
+      and (IdentItem.Node<>nil) then begin
+        //DebugLn(['GetIdentCompletionValue icvCompleteProcDeclaration']);
+        ValueType:=icvCompleteProcDeclaration;
+      end else if IdentItem.IsProcNodeWithParams then
         ValueType:=icvProcWithParams;
 
     ctnProperty:
@@ -399,10 +409,10 @@ begin
 
   end;
 
-  // add brackets for parameter lists
   case ValueType of
   
     icvProcWithParams:
+      // add brackets for parameter lists
       if (not IdentList.StartUpAtomBehindIs('('))
       and (not IdentList.StartUpAtomInFrontIs('@')) then begin
         Result:=Result+'()';
@@ -411,11 +421,32 @@ begin
       end;
 
     icvIndexedProp:
+      // add brackets for parameter lists
       if (not IdentList.StartUpAtomBehindIs('[')) then begin
         Result:=Result+'[]';
         inc(CursorToLeft);
         CursorAtEnd:=false;
       end;
+      
+    icvCompleteProcDeclaration:
+      // create complete procedure declaration
+      if (not IdentList.StartUpAtomBehindIs('('))
+      and (IdentItem.Node<>nil) then begin
+        Result:=IdentItem.Tool.ExtractProcHead(IdentItem.Node,
+          [phpWithStart,phpWithVarModifiers,phpWithParameterNames,
+           phpWithDefaultValues,phpWithResultType,phpWithCallingSpecs,
+           phpCommentsToSpace,phpWithProcModifiers]);
+        // replace virtual with override
+        ProcModifierPos:=System.Pos('VIRTUAL;',UpperCaseStr(Result));
+        if ProcModifierPos>0 then
+          Result:=copy(Result,1,ProcModifierPos-1)+'override;'
+                  +copy(Result,ProcModifierPos+8,length(Result));
+        // remove abstact
+        ProcModifierPos:=System.Pos('ABSTRACT;',UpperCaseStr(Result));
+        if ProcModifierPos>0 then
+          Result:=copy(Result,1,ProcModifierPos-1)
+                  +copy(Result,ProcModifierPos+9,length(Result));
+      end;
   end;
 
   {if (ilcfStartIsLValue in IdentList.ContextFlags)