mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-11-04 09:19:50 +01:00 
			
		
		
		
	fixed da_IF and find record case variable
git-svn-id: trunk@4389 -
This commit is contained in:
		
							parent
							
								
									2b1c3e2616
								
							
						
					
					
						commit
						b371e11fc9
					
				@ -1753,9 +1753,11 @@ begin
 | 
			
		||||
      DirDef.Path:=ExpPath;
 | 
			
		||||
      //writeln('[TDefineTree.GetDefinesForDirectory] B ',ExpPath,' ');
 | 
			
		||||
      if Calculate(DirDef) then begin
 | 
			
		||||
        //writeln('[TDefineTree.GetDefinesForDirectory] C success');
 | 
			
		||||
        FCache.Add(DirDef);
 | 
			
		||||
        Result:=DirDef.Values;
 | 
			
		||||
      end else begin
 | 
			
		||||
        //writeln('[TDefineTree.GetDefinesForDirectory] D failed');
 | 
			
		||||
        DirDef.Free;
 | 
			
		||||
        Result:=nil;
 | 
			
		||||
      end;
 | 
			
		||||
@ -3279,8 +3281,8 @@ begin
 | 
			
		||||
  IntfDirTemplate:=TDefineTemplate.Create('gtkIntfDirectory',
 | 
			
		||||
    ctsGtkIntfDirectory,'','gtk',da_Directory);
 | 
			
		||||
    // if LCLWidgetType=gtk2
 | 
			
		||||
    IfTemplate:=TDefineTemplate.Create('IF '+WidgetType+'=gtk2',
 | 
			
		||||
      ctsIfLCLWidgetTypeEqualsGtk2,'',WidgetType+'=gtk2',da_If);
 | 
			
		||||
    IfTemplate:=TDefineTemplate.Create('IF '+WidgetType+'=''gtk2''',
 | 
			
		||||
      ctsIfLCLWidgetTypeEqualsGtk2,'',WidgetType+'=''gtk2''',da_If);
 | 
			
		||||
      // then define gtk2
 | 
			
		||||
      IfTemplate.AddChild(TDefineTemplate.Create('Define gtk2',
 | 
			
		||||
        ctsDefineMacroGTK2,'gtk2','',da_Define));
 | 
			
		||||
@ -3304,8 +3306,8 @@ begin
 | 
			
		||||
    Format(ctsAddsDirToSourcePath,['gtk']),ExternalMacroStart+'SrcPath',
 | 
			
		||||
    '..'+ds+'gtk;'+SrcPath,da_Define));
 | 
			
		||||
    // if LCLWidgetType=gnome2
 | 
			
		||||
    IfTemplate:=TDefineTemplate.Create('IF '+WidgetType+'=gnome2',
 | 
			
		||||
      ctsIfLCLWidgetTypeEqualsGnome2,'',WidgetType+'=gnome2',da_If);
 | 
			
		||||
    IfTemplate:=TDefineTemplate.Create('IF '+WidgetType+'=''gnome2''',
 | 
			
		||||
      ctsIfLCLWidgetTypeEqualsGnome2,'',WidgetType+'=''gnome2''',da_If);
 | 
			
		||||
      // then define gnome2
 | 
			
		||||
      IfTemplate.AddChild(TDefineTemplate.Create('Define gnome2',
 | 
			
		||||
        ctsDefineMacroGTK2,'gnome2','',da_Define));
 | 
			
		||||
 | 
			
		||||
@ -126,19 +126,37 @@ function TExpressionEvaluator.CompareValues(const v1, v2: string): integer;
 | 
			
		||||
//  0 : v1=v2
 | 
			
		||||
//  1 : v1>v2
 | 
			
		||||
var len1,len2,a:integer;
 | 
			
		||||
  c1: Char;
 | 
			
		||||
  c2: Char;
 | 
			
		||||
  ValPos1: Integer;
 | 
			
		||||
  ValPos2: Integer;
 | 
			
		||||
begin
 | 
			
		||||
  len1:=length(v1);
 | 
			
		||||
  len2:=length(v2);
 | 
			
		||||
  ValPos1:=1;
 | 
			
		||||
  ValPos2:=1;
 | 
			
		||||
  if (len1>1) and (v1[ValPos1]='''') then begin
 | 
			
		||||
    inc(ValPos1);
 | 
			
		||||
    dec(Len1,2);
 | 
			
		||||
  end;
 | 
			
		||||
  if (len2>1) and (v2[ValPos2]='''') then begin
 | 
			
		||||
    inc(ValPos2);
 | 
			
		||||
    dec(Len2,2);
 | 
			
		||||
  end;
 | 
			
		||||
  if len1<len2 then Result:=-1
 | 
			
		||||
  else if len1>len2 then Result:=1
 | 
			
		||||
  else begin
 | 
			
		||||
    for a:=1 to len1 do begin
 | 
			
		||||
      if v1[a]<v2[a] then begin
 | 
			
		||||
      c1:=v1[ValPos1];
 | 
			
		||||
      c2:=v2[ValPos2];
 | 
			
		||||
      if c1<c2 then begin
 | 
			
		||||
        Result:=-1;  exit;
 | 
			
		||||
      end;
 | 
			
		||||
      if v1[a]>v2[a] then begin
 | 
			
		||||
      if c1>c2 then begin
 | 
			
		||||
        Result:=1;  exit;
 | 
			
		||||
      end;
 | 
			
		||||
      inc(ValPos1);
 | 
			
		||||
      inc(ValPos2);
 | 
			
		||||
    end;
 | 
			
		||||
    Result:=0;
 | 
			
		||||
  end;
 | 
			
		||||
@ -296,6 +314,8 @@ begin
 | 
			
		||||
      if (Result<>'') then begin
 | 
			
		||||
        ErrorPos:=CurPos;  exit;
 | 
			
		||||
      end else Result:=copy(Expr,AtomStart,AtomEnd-AtomStart);
 | 
			
		||||
    end else if c='''' then begin
 | 
			
		||||
      Result:=copy(Expr,AtomStart+1,AtomEnd-AtomStart-2);
 | 
			
		||||
    end else begin
 | 
			
		||||
      // operator
 | 
			
		||||
      case c of
 | 
			
		||||
@ -437,6 +457,23 @@ begin
 | 
			
		||||
      AtomEnd:=CurPos;
 | 
			
		||||
      Result:=true;
 | 
			
		||||
      exit;
 | 
			
		||||
    end else if c='''' then begin
 | 
			
		||||
      // string
 | 
			
		||||
      AtomStart:=CurPos;
 | 
			
		||||
      repeat
 | 
			
		||||
        inc(CurPos);
 | 
			
		||||
        if Expr[CurPos]='''' then begin
 | 
			
		||||
          inc(CurPos);
 | 
			
		||||
          AtomEnd:=CurPos;
 | 
			
		||||
          Result:=true;
 | 
			
		||||
          exit;
 | 
			
		||||
        end;
 | 
			
		||||
        if CurPos>Max then begin
 | 
			
		||||
          AtomEnd:=CurPos;
 | 
			
		||||
          Result:=false;
 | 
			
		||||
          exit;
 | 
			
		||||
        end;
 | 
			
		||||
      until (CurPos>Max);
 | 
			
		||||
    end else begin
 | 
			
		||||
      // Symbol
 | 
			
		||||
      AtomStart:=CurPos;
 | 
			
		||||
@ -444,7 +481,7 @@ begin
 | 
			
		||||
      if (CurPos<=Max) then begin
 | 
			
		||||
        o1:=c;
 | 
			
		||||
        o2:=Expr[CurPos];
 | 
			
		||||
        if ((o2='=') and ( (o1='<') or (o1='>') ))
 | 
			
		||||
        if ((o2='=') and ((o1='<') or (o1='>')))
 | 
			
		||||
        or ((o1='<') and (o2='>'))
 | 
			
		||||
        then inc(CurPos);
 | 
			
		||||
      end;
 | 
			
		||||
 | 
			
		||||
@ -521,6 +521,8 @@ type
 | 
			
		||||
      Params: TFindDeclarationParams): boolean;
 | 
			
		||||
    function FindIdentifierInUsedUnit(const AnUnitName: string;
 | 
			
		||||
      Params: TFindDeclarationParams): boolean;
 | 
			
		||||
    function FindIdentifierInRecordCase(RecordCaseNode: TCodeTreeNode;
 | 
			
		||||
      Params: TFindDeclarationParams): boolean;
 | 
			
		||||
  protected
 | 
			
		||||
    WordIsPredefinedIdentifier: TKeyWordFunctionList;
 | 
			
		||||
    procedure BeginParsing(DeleteNodes, OnlyInterfaceNeeded: boolean); override;
 | 
			
		||||
@ -2016,7 +2018,7 @@ var
 | 
			
		||||
        ctnLabelSection,
 | 
			
		||||
        ctnInterface, ctnImplementation,
 | 
			
		||||
        ctnClassPublished,ctnClassPublic,ctnClassProtected,ctnClassPrivate,
 | 
			
		||||
        ctnRecordCase, ctnRecordVariant,
 | 
			
		||||
        ctnRecordVariant,
 | 
			
		||||
        ctnProcedureHead, ctnParameterList:
 | 
			
		||||
          // these codetreenodes build a parent-child-relationship, but
 | 
			
		||||
          // for pascal it is only a range, hence after searching in the
 | 
			
		||||
@ -2028,6 +2030,9 @@ var
 | 
			
		||||
          // do not search again in this node, go on ...
 | 
			
		||||
          ;
 | 
			
		||||
          
 | 
			
		||||
        ctnRecordCase:
 | 
			
		||||
          break;
 | 
			
		||||
 | 
			
		||||
        ctnVarDefinition, ctnConstDefinition:
 | 
			
		||||
          if (ContextNode.Parent<>nil)
 | 
			
		||||
          and (ContextNode.Parent.Desc=ctnParameterList) then begin
 | 
			
		||||
@ -2121,7 +2126,7 @@ begin
 | 
			
		||||
        ctnInterface, ctnImplementation,
 | 
			
		||||
        ctnClassPublic, ctnClassPrivate, ctnClassProtected, ctnClassPublished,
 | 
			
		||||
        ctnClass, ctnClassInterface,
 | 
			
		||||
        ctnRecordType, ctnRecordCase, ctnRecordVariant,
 | 
			
		||||
        ctnRecordType, ctnRecordVariant,
 | 
			
		||||
        ctnParameterList:
 | 
			
		||||
          // these nodes build a parent-child relationship. But in pascal
 | 
			
		||||
          // they just define a range and not a context.
 | 
			
		||||
@ -2177,6 +2182,13 @@ begin
 | 
			
		||||
              exit;
 | 
			
		||||
          end;
 | 
			
		||||
 | 
			
		||||
        ctnRecordCase:
 | 
			
		||||
          begin
 | 
			
		||||
            if FindIdentifierInRecordCase(ContextNode,Params)
 | 
			
		||||
            and CheckResult(true,false) then
 | 
			
		||||
              exit;
 | 
			
		||||
          end;
 | 
			
		||||
          
 | 
			
		||||
        end;
 | 
			
		||||
      end else begin
 | 
			
		||||
        Exclude(Params.Flags,fdfIgnoreCurContextNode);
 | 
			
		||||
@ -3399,6 +3411,26 @@ begin
 | 
			
		||||
  end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function TFindDeclarationTool.FindIdentifierInRecordCase(
 | 
			
		||||
  RecordCaseNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
 | 
			
		||||
begin
 | 
			
		||||
  Result:=false;
 | 
			
		||||
  MoveCursorToNodeStart(RecordCaseNode);
 | 
			
		||||
  ReadNextAtom;
 | 
			
		||||
  ReadNextAtom;
 | 
			
		||||
  if (fdfCollect in Params.Flags)
 | 
			
		||||
  or CompareSrcIdentifiers(CurPos.StartPos,Params.Identifier) then begin
 | 
			
		||||
    // identifier found
 | 
			
		||||
    {$IFDEF ShowTriedContexts}
 | 
			
		||||
    writeln('[TFindDeclarationTool.FindIdentifierInRecordCase]  found="',GetIdentifier(Params.Identifier),'"');
 | 
			
		||||
    {$ENDIF}
 | 
			
		||||
    Params.SetResult(Self,RecordCaseNode,CurPos.StartPos);
 | 
			
		||||
    Result:=true;
 | 
			
		||||
  end else begin
 | 
			
		||||
    // proceed the search normally ...
 | 
			
		||||
  end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
procedure TFindDeclarationTool.BeginParsing(DeleteNodes,
 | 
			
		||||
  OnlyInterfaceNeeded: boolean);
 | 
			
		||||
begin
 | 
			
		||||
 | 
			
		||||
@ -5880,7 +5880,7 @@ var
 | 
			
		||||
    end;
 | 
			
		||||
    // delete unneeded menuitems
 | 
			
		||||
    while ExistingCount>ToolCount do begin
 | 
			
		||||
      mnuTools[LastIndex].Free;
 | 
			
		||||
      mnuTools[LastIndex-1].Free;
 | 
			
		||||
      dec(LastIndex);
 | 
			
		||||
      dec(ExistingCount);
 | 
			
		||||
    end;
 | 
			
		||||
@ -9354,6 +9354,9 @@ end.
 | 
			
		||||
 | 
			
		||||
{ =============================================================================
 | 
			
		||||
  $Log$
 | 
			
		||||
  Revision 1.621  2003/07/09 00:35:38  mattias
 | 
			
		||||
  fixed da_IF and find record case variable
 | 
			
		||||
 | 
			
		||||
  Revision 1.620  2003/07/08 11:30:22  mattias
 | 
			
		||||
  added Abort Build
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										3098
									
								
								lcl/grids.pas
									
									
									
									
									
								
							
							
						
						
									
										3098
									
								
								lcl/grids.pas
									
									
									
									
									
								
							
										
											
												File diff suppressed because it is too large
												Load Diff
											
										
									
								
							
		Loading…
	
		Reference in New Issue
	
	Block a user