diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index bd49731cf8..3c0c568419 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -324,6 +324,11 @@ type const Filename: string = ''; SearchInCleanSrc: boolean = true): boolean; function AddResourceDirective(Code: TCodeBuffer; const Filename: string; SearchInCleanSrc: boolean = true; const NewSrc: string = ''): boolean; + function FindIncludeDirective(Code: TCodeBuffer; StartX, StartY: integer; + out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer; + const Filename: string = ''; SearchInCleanSrc: boolean = true): boolean; + function AddIncludeDirective(Code: TCodeBuffer; const Filename: string; + const NewSrc: string = ''): boolean; function RemoveDirective(Code: TCodeBuffer; NewX, NewY: integer; RemoveEmptyIFs: boolean): boolean; function FixIncludeFilenames(Code: TCodeBuffer; Recursive: boolean; @@ -567,7 +572,7 @@ type function RenameMainInclude(Code: TCodeBuffer; const NewFilename: string; KeepPath: boolean): boolean; function RenameIncludeDirective(Code: TCodeBuffer; LinkIndex: integer; - const NewFilename: string; KeepPath: boolean): boolean; + const NewFilename: string; KeepPath: boolean): boolean;// in cleaned source procedure DefaultFindDefinePropertyForContext(Sender: TObject; const ClassContext, AncestorClassContext: TFindContext; LFMNode: TLFMTreeNode; @@ -2550,6 +2555,80 @@ begin end; end; +function TCodeToolManager.FindIncludeDirective(Code: TCodeBuffer; StartX, + StartY: integer; out NewCode: TCodeBuffer; out NewX, NewY, + NewTopLine: integer; const Filename: string; SearchInCleanSrc: boolean + ): boolean; +var + CursorPos: TCodeXYPosition; + NewPos: TCodeXYPosition; + Tree: TCompilerDirectivesTree; + p: integer; +begin + Result:=false; + {$IFDEF CTDEBUG} + DebugLn('TCodeToolManager.FindIncludeDirective A ',Code.Filename); + {$ENDIF} + NewCode:=nil; + NewX:=0; + NewY:=0; + NewTopLine:=0; + if SearchInCleanSrc then begin + if not InitCurCodeTool(Code) then exit; + CursorPos.X:=StartX; + CursorPos.Y:=StartY; + CursorPos.Code:=Code; + try + Result:=FCurCodeTool.FindIncludeDirective(CursorPos,NewPos,NewTopLine, + Filename); + if Result then begin + NewX:=NewPos.X; + NewY:=NewPos.Y; + NewCode:=NewPos.Code; + end; + except + on e: Exception do Result:=HandleException(e); + end; + end else begin + try + Tree:=TCompilerDirectivesTree.Create; + try + Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename)); + Code.LineColToPosition(StartY,StartX,p); + Result:=Tree.NodeStartToCodePos(Tree.FindIncludeDirective(Filename,p), + CursorPos); + NewCode:=CursorPos.Code; + NewX:=CursorPos.X; + NewY:=CursorPos.Y; + NewTopLine:=NewY; + finally + Tree.Free; + end; + except + on e: Exception do Result:=HandleException(e); + end; + end; +end; + +function TCodeToolManager.AddIncludeDirective(Code: TCodeBuffer; + const Filename: string; const NewSrc: string + ): boolean; +var + Tree: TCompilerDirectivesTree; + Node: TCodeTreeNode; +begin + Result:=false; + {$IFDEF CTDEBUG} + DebugLn('TCodeToolManager.AddIncludeDirective A ',Code.Filename,' Filename=',Filename); + {$ENDIF} + if not InitCurCodeTool(Code) then exit; + try + Result:=FCurCodeTool.AddIncludeDirective(Filename,SourceChangeCache,NewSrc); + except + on e: Exception do Result:=HandleException(e); + end; +end; + function TCodeToolManager.RemoveDirective(Code: TCodeBuffer; NewX, NewY: integer; RemoveEmptyIFs: boolean): boolean; var diff --git a/components/codetools/directivestree.pas b/components/codetools/directivestree.pas index cf2055d810..ac06711857 100644 --- a/components/codetools/directivestree.pas +++ b/components/codetools/directivestree.pas @@ -52,6 +52,7 @@ const cdnRoot = 1+cdnBase; cdnDefine = 11+cdnBase; + cdnInclude = 12+cdnBase; cdnIf = 21+cdnBase; cdnElseIf = 22+cdnBase; @@ -204,6 +205,11 @@ type function IsResourceDirective(Node: TCodeTreeNode; const Filename: string = ''): boolean; + function FindIncludeDirective(const Filename: string = ''; + StartPos: integer = 1): TCodeTreeNode; + function IsIncludeDirective(Node: TCodeTreeNode; + const Filename: string = ''): boolean; + function GetDirectiveName(Node: TCodeTreeNode): string; function GetDirective(Node: TCodeTreeNode): string; function GetIfExpression(Node: TCodeTreeNode; @@ -518,6 +524,9 @@ end; function TCompilerDirectivesTree.IncludeDirective: boolean; begin Result:=true; + CreateChildNode(cdnInclude,cdnsInclude); + AtomStart:=SrcPos; + EndChildNode; end; function TCompilerDirectivesTree.IncludePathDirective: boolean; @@ -532,8 +541,12 @@ begin Result:=true; if Src[AtomStart+3] in ['+','-'] then CreateChildNode(cdnDefine,cdnsShortSwitch) - else - CreateChildNode(cdnDefine,cdnsOther); + else begin + if (Src[AtomStart+2] in ['I','i']) then + CreateChildNode(cdnInclude,cdnsInclude) + else + CreateChildNode(cdnDefine,cdnsOther); + end; AtomStart:=SrcPos; EndChildNode; end; @@ -1305,7 +1318,7 @@ procedure TCompilerDirectivesTree.DisableNode(Node: TCodeTreeNode; begin if Node=nil then exit; case Node.Desc of - cdnDefine: DisableDefineNode(Node,Changed); + cdnDefine, cdnInclude: DisableDefineNode(Node,Changed); cdnIf, cdnElseIf, cdnElse: DisableIfNode(Node,WithContent,Changed); end; end; @@ -2283,7 +2296,50 @@ begin if (Filename='') then exit(true); inc(p,4); while (pnil do begin + if (Result.StartPos>=StartPos) + and IsIncludeDirective(Result,Filename) then exit; + Result:=Result.Next; + end; +end; + +function TCompilerDirectivesTree.IsIncludeDirective(Node: TCodeTreeNode; + const Filename: string): boolean; +// search for {$I filename} +// if filename='' then search for any {$I } directive +// Beware: do not find {$I+} +var + p: LongInt; + FilenameStartPos: integer; + FilenameEndPos: integer; + CommentStart: integer; + CommentEnd: integer; +begin + Result:=false; + //debugln(['TCompilerDirectivesTree.IsIncludeDirective ',CDNodeDescAsString(Node.Desc)]); + if (Node=nil) or (Node.Desc<>cdnInclude) then exit; + p:=Node.StartPos; + if (Node.EndPos-p>=5) and (Src[p]='{') and (Src[p+1]='$') and (Src[p+2]='I') + then begin + if (Filename='') then exit(true); + if FindNextIncludeDirective(Src,p,NestedComments, + FilenameStartPos,FilenameEndPos,CommentStart,CommentEnd)=p then + begin; + if CompareFilenamesIgnoreCase(Filename, + copy(Src,FilenameStartPos,FilenameEndPos-FilenameStartPos))=0 + then + exit(true); + end; end; end; diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index a1d001e7de..d9f98d729e 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -219,6 +219,14 @@ type function AddResourceDirective(const Filename: string; SourceChangeCache: TSourceChangeCache; const NewSrc: string = '' ): boolean; + function FindIncludeDirective(DoBuildTree: boolean; + var ACleanPos: integer; const Filename: string = ''): boolean; + function FindIncludeDirective(const CursorPos: TCodeXYPosition; + out NewPos: TCodeXYPosition; out NewTopLine: integer; + const Filename: string = ''): boolean; + function AddIncludeDirective(const Filename: string; + SourceChangeCache: TSourceChangeCache; const NewSrc: string = '' + ): boolean; function FixIncludeFilenames(Code: TCodeBuffer; SourceChangeCache: TSourceChangeCache; out FoundIncludeFiles: TStrings; @@ -4811,6 +4819,98 @@ begin Result:=true; end; +function TStandardCodeTool.FindIncludeDirective(DoBuildTree: boolean; + var ACleanPos: integer; const Filename: string): boolean; +var + ParamPos: Integer; + FilenameStartPos: Integer; + FilenameEndPos: LongInt; + CommentStart: integer; + CommentEnd: integer; +begin + Result:=false; + if DoBuildTree then BuildTree(true); + ACleanPos:=1; + repeat + ACleanPos:=FindNextIncludeDirective(Src,ACleanPos,Scanner.NestedComments, + FilenameStartPos,FilenameEndPos,CommentStart,CommentEnd); + if (ACleanPos<1) or (ACleanPos>SrcLen) then + exit(false); + if Filename='' then begin + // searching any filename -> found + exit(true); + end; + if CompareText(PChar(Pointer(Filename)),length(Filename), + @Src[FilenameStartPos],FilenameEndPos-FilenameStartPos, + true,false)=0 + then begin + // filename found + exit(true); + end; + ACleanPos:=FilenameEndPos+1; + until ACleanPos>SrcLen; +end; + +function TStandardCodeTool.FindIncludeDirective( + const CursorPos: TCodeXYPosition; out NewPos: TCodeXYPosition; out + NewTopLine: integer; const Filename: string): boolean; +var + CleanCursorPos: integer; +begin + Result:=false; + BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]); + if not FindIncludeDirective(false,CleanCursorPos,Filename) then begin + //DebugLn('TStandardCodeTool.FindIncludeDirective resource directive not found'); + exit; + end; + Result:=CleanPosToCaretAndTopLine(CleanCursorPos,NewPos,NewTopLine); +end; + +function TStandardCodeTool.AddIncludeDirective(const Filename: string; + SourceChangeCache: TSourceChangeCache; const NewSrc: string): boolean; +var + ANode: TCodeTreeNode; + Indent: LongInt; + InsertPos: Integer; + AddSrc: String; +begin + Result:=false; + BuildTree(true); + // find an insert position + ANode:=FindImplementationNode; + if ANode<>nil then begin + Indent:=GetLineIndent(Src,ANode.StartPos); + InsertPos:=ANode.StartPos+length('implementation'); + end else begin + ANode:=FindMainBeginEndNode; + if ANode<>nil then begin + Indent:=GetLineIndent(Src,ANode.StartPos); + InsertPos:=ANode.StartPos; + end else begin + ANode:=FindMainUsesSection; + if ANode<>nil then begin + Indent:=GetLineIndent(Src,ANode.StartPos); + InsertPos:=ANode.StartPos; + end else begin + Indent:=0; + InsertPos:=1; + end; + end; + end; + + // insert directive + SourceChangeCache.MainScanner:=Scanner; + if NewSrc<>'' then + AddSrc:=NewSrc + else + AddSrc:=GetIndentStr(Indent)+'{$I '+Filename+'}'; + if not SourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos, + AddSrc) then exit; + if not SourceChangeCache.Apply then exit; + + Result:=true; +end; + function TStandardCodeTool.FixIncludeFilenames(Code: TCodeBuffer; SourceChangeCache: TSourceChangeCache; out FoundIncludeFiles: TStrings; diff --git a/ide/projectresources.pas b/ide/projectresources.pas index d0e209bd61..676e49b028 100644 --- a/ide/projectresources.pas +++ b/ide/projectresources.pas @@ -40,7 +40,7 @@ uses Classes, SysUtils, LCLProc, LResources, FileUtil, ProjectResourcesIntf, W32VersionInfo, W32Manifest, ProjectIcon, - CodeToolManager, CodeCache, CodeAtom; + BasicCodeTools, CodeToolManager, CodeCache, CodeAtom; type @@ -253,7 +253,9 @@ begin begin SetFileNames('', AFileName); Filename := ExtractFileName(rcFileName); - debugln(['TProjectResources.UpdateMainSourceFile HasSystemResources=',HasSystemResources,' Filename=',Filename,' HasLazarusResource=',HasLazarusResource]); + //debugln(['TProjectResources.UpdateMainSourceFile HasSystemResources=',HasSystemResources,' Filename=',Filename,' HasLazarusResource=',HasLazarusResource]); + + // update {$R filename} directive if CodeToolBoss.FindResourceDirective(CodeBuf, 1, 1, NewCode, NewX, NewY, NewTopLine, Filename, false) then @@ -263,8 +265,8 @@ begin begin if not CodeToolBoss.RemoveDirective(NewCode, NewX,NewY,true) then begin + debugln(['TProjectResources.UpdateMainSourceFile failed: removing resource directive']); // Messages.Add('Could not remove "{$R'+ Filename +'"} from main source!'); - Exit; end; end; end @@ -274,7 +276,38 @@ begin if not CodeToolBoss.AddResourceDirective(CodeBuf, Filename,false,'{$IFDEF WINDOWS}{$R '+Filename+'}{$ENDIF}') then begin - // Messages.Add('Could not add "{$R'+ Filename +'"} to main source!'); + debugln(['TProjectResources.UpdateMainSourceFile failed: adding resource directive']); + // Messages.Add('Could not add "{$R '+ Filename +'"} to main source!'); + end; + end; + + // update {$I filename} directive + Filename := ExtractFileName(lrsFileName); + if CodeToolBoss.FindIncludeDirective(CodeBuf, 1, 1, + NewCode, NewX, NewY, + NewTopLine, Filename, false) then + begin + // there is a resource directive in the source + //debugln(['TProjectResources.UpdateMainSourceFile include directive found']); + if not HasLazarusResource then + begin + if not CodeToolBoss.RemoveDirective(NewCode, NewX,NewY,true) then + begin + debugln(['TProjectResources.UpdateMainSourceFile removing include directive from main source failed']); + // Messages.Add('Could not remove "{$I '+ Filename +'"} from main source!'); + Exit; + end; + end; + end + else + if HasLazarusResource then + begin + //debugln(['TProjectResources.UpdateMainSourceFile include directive not found']); + if not CodeToolBoss.AddIncludeDirective(CodeBuf, + Filename,'{$IFDEF WINDOWS}{$I '+Filename+'}{$ENDIF}') then + begin + debugln(['TProjectResources.UpdateMainSourceFile adding include directive to main source failed']); + // Messages.Add('Could not add "{$I'+ Filename +'"} to main source!'); Exit; end; end;