paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-31 19:52:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: improved updating resource directives for windows manifest and version info

Browse Source 
git-svn-id: trunk@13040 -
This commit is contained in:
mattias 2007-11-26 20:05:30 +00:00
parent 5c30e13681
commit d815ea8ea2
11 changed files with 232 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
components/codetools/codetoolmanager.pas
View File

@ -323,6 +323,8 @@ type
const Filename: string = ''; SearchInCleanSrc: boolean = true): boolean;
function AddResourceDirective(Code: TCodeBuffer; const Filename: string;
SearchInCleanSrc: boolean = true; const NewSrc: string = ''): boolean;
function RemoveDirective(Code: TCodeBuffer; NewX, NewY: integer;
RemoveEmptyIFs: boolean): boolean;
function FixIncludeFilenames(Code: TCodeBuffer; Recursive: boolean;
out MissingIncludeFilesCodeXYPos: TFPList): boolean;
function FixMissingH2PasDirectives(Code: TCodeBuffer;
@ -2442,6 +2444,41 @@ begin
end;
end;
function TCodeToolManager.RemoveDirective(Code: TCodeBuffer; NewX,
NewY: integer; RemoveEmptyIFs: boolean): boolean;
var
Tree: TCompilerDirectivesTree;
p: integer;
Node: TCodeTreeNode;
Changed: boolean;
ParentNode: TCodeTreeNode;
begin
Result:=false;
{$IFDEF CTDEBUG}
DebugLn('TCodeToolManager.RemoveDirective A ',Code.Filename);
{$ENDIF}
try
Code.LineColToPosition(NewY,NewX,p);
if (p<1) or (p>Code.SourceLength) then exit;
Tree:=TCompilerDirectivesTree.Create;
try
Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename));
Node:=Tree.FindNodeAtPos(p);
if Node=nil then exit;
ParentNode:=Node.Parent;
Changed:=false;
Tree.DisableNode(Node,Changed,true);
if RemoveEmptyIFs and (ParentNode<>nil) and Tree.NodeIsEmpty(ParentNode) then
Tree.DisableNode(ParentNode,Changed,true);
Result:=Changed;
finally
Tree.Free;
end;
except
on e: Exception do Result:=HandleException(e);
end;
end;
function TCodeToolManager.FixIncludeFilenames(Code: TCodeBuffer;
Recursive: boolean; out MissingIncludeFilesCodeXYPos: TFPList): boolean;

141
components/codetools/directivestree.pas
View File

@ -140,21 +140,7 @@ type
procedure EndChildNode;
procedure EndIFNode(const ErrorMsg: string);
procedure CheckAndImproveExpr_Brackets(Node: TCodeTreeNode;
var Changed: boolean);
procedure CheckAndImproveExpr_IfDefinedMacro(Node: TCodeTreeNode;
var Changed: boolean);
procedure DisableAllUnusedDefines(var Changed: boolean);
procedure MoveIfNotThenDefsUp(var Changed: boolean);
procedure DisableUnreachableBlocks(Undefines, Defines: TStrings;
var Changed: boolean);
procedure DisableDefineNode(Node: TCodeTreeNode; var Changed: boolean);
procedure DisableIfNode(Node: TCodeTreeNode; WithContent: boolean;
var Changed: boolean);
procedure RemoveNode(Node: TCodeTreeNode);
procedure RemoveEmptyNodes(var Changed: boolean);
function InsertDefine(Position: integer; const NewSrc: string;
SubDesc: TCompilerDirectiveNodeDesc): TCodeTreeNode;
procedure InternalRemoveNode(Node: TCodeTreeNode);
public
Code: TCodeBuffer;
Src: string;
@ -180,12 +166,11 @@ type
FindDefNodes: boolean);
procedure FixMissingH2PasDirectives(var Changed: boolean);
function NodeStartToCodePos(Node: TCodeTreeNode;
out CodePos: TCodeXYPosition): boolean;
function FindResourceDirective(const Filename: string = '';
StartPos: integer = 1): TCodeTreeNode;
function IsResourceDirective(Node: TCodeTreeNode;
const Filename: string = ''): boolean;
function GetDirectiveName(Node: TCodeTreeNode): string;
function GetDirective(Node: TCodeTreeNode): string;
function GetIfExpression(Node: TCodeTreeNode;
@ -200,7 +185,28 @@ type
): boolean;
function DefineUsesName(DefineNode: TCodeTreeNode;
Identifier: PChar): boolean;
function NodeIsEmpty(Node: TCodeTreeNode; IgnoreComments: boolean = true): boolean;
function FindNodeAtPos(p: integer): TCodeTreeNode;
function NodeStartToCodePos(Node: TCodeTreeNode;
out CodePos: TCodeXYPosition): boolean;
procedure CheckAndImproveExpr_Brackets(Node: TCodeTreeNode;
var Changed: boolean);
procedure CheckAndImproveExpr_IfDefinedMacro(Node: TCodeTreeNode;
var Changed: boolean);
procedure DisableAllUnusedDefines(var Changed: boolean);
procedure MoveIfNotThenDefsUp(var Changed: boolean);
procedure DisableUnreachableBlocks(Undefines, Defines: TStrings;
var Changed: boolean);
procedure DisableNode(Node: TCodeTreeNode; var Changed: boolean;
WithContent: boolean);
procedure DisableDefineNode(Node: TCodeTreeNode; var Changed: boolean);
procedure DisableIfNode(Node: TCodeTreeNode; WithContent: boolean;
var Changed: boolean);
function InsertDefine(Position: integer; const NewSrc: string;
SubDesc: TCompilerDirectiveNodeDesc): TCodeTreeNode;
procedure RemoveEmptyNodes(var Changed: boolean);
procedure MoveCursorToPos(p: integer);
procedure ReadNextAtom;
function ReadTilBracketClose(CloseBracket: char): boolean;
@ -208,7 +214,9 @@ type
function UpAtomIs(const s: shortstring): boolean;
function AtomIsIdentifier: boolean;
function GetAtom: string;
procedure Replace(FromPos, ToPos: integer; const NewSrc: string);
procedure IncreaseChangeStep;
procedure ResetMacros;
procedure ClearMacros;
@ -1317,6 +1325,16 @@ begin
{$ENDIF}
end;
procedure TCompilerDirectivesTree.DisableNode(Node: TCodeTreeNode;
var Changed: boolean; WithContent: boolean);
begin
if Node=nil then exit;
case Node.Desc of
cdnDefine: DisableDefineNode(Node,Changed);
cdnIf, cdnElseIf, cdnElse: DisableIfNode(Node,WithContent,Changed);
end;
end;
procedure TCompilerDirectivesTree.DisableDefineNode(Node: TCodeTreeNode;
var Changed: boolean);
var
@ -1341,11 +1359,11 @@ begin
end;
Replace(FromPos,ToPos,NewSrc);
end else begin
// disable directive -> {$off Define MacroName}
// disable directive -> {off $Define MacroName}
Replace(Node.StartPos+1,Node.StartPos+1,'off ');
end;
Changed:=true;
RemoveNode(Node);
InternalRemoveNode(Node);
end;
procedure TCompilerDirectivesTree.DisableIfNode(Node: TCodeTreeNode;
@ -1430,7 +1448,7 @@ procedure TCompilerDirectivesTree.DisableIfNode(Node: TCodeTreeNode;
end else begin
// free nodes and delete code
while Node.FirstChild<>nil do
RemoveNode(Node.FirstChild);
InternalRemoveNode(Node.FirstChild);
FromPos:=FindCommentEnd(Src,Node.StartPos,NestedComments);
ToPos:=Node.NextBrother.StartPos;
if RemoveDisabledDirectives then begin
@ -1457,6 +1475,7 @@ var
Simplified: Boolean;
ExprNegated: boolean;
Expr2Negated: boolean;
p: LongInt;
begin
if (Node.NextBrother=nil) then
RaiseImpossible;
@ -1520,6 +1539,29 @@ begin
ToPos:=Node.NextBrother.StartPos;
if WithContent then begin
// remove node source with content
if (FromPos>1) and (Src[FromPos-1] in [#10,#13])
and (ToPos<=SrcLen) and (Src[ToPos] in [#10,#13]) then begin
// the directive has a complete line
// remove the line end too
inc(ToPos);
if (ToPos<=SrcLen) and (Src[ToPos] in [#10,#13]) and (Src[ToPos]<>Src[ToPos-1])
then inc(ToPos);
if (ToPos<=SrcLen) and (Src[ToPos] in [#10,#13]) then begin
// there is an empty line behind the directive
// check if there is an empty line in front of the directive
p:=FromPos;
if (p>1) and (Src[p-1] in [#10,#13]) then begin
dec(p);
if (p>1) and (Src[p-1] in [#10,#13]) and (Src[p]<>Src[p-1]) then
dec(p);
if (p>1) and (Src[p-1] in [#10,#13]) then begin
// there is an empty line in front of the directive too
// => remove one empty line
FromPos:=p;
end;
end;
end;
end;
Replace(FromPos,ToPos,'');
end else begin
// remove node source keeping content (child node source)
@ -1538,24 +1580,26 @@ begin
end;
if Node.NextBrother.Desc=cdnEnd then
RemoveNode(Node.NextBrother);
RemoveNode(Node);
InternalRemoveNode(Node.NextBrother);
InternalRemoveNode(Node);
end;
procedure TCompilerDirectivesTree.RemoveNode(Node: TCodeTreeNode);
procedure TCompilerDirectivesTree.InternalRemoveNode(Node: TCodeTreeNode);
var
AVLNode: TAVLTreeNode;
MacroNode: TCompilerMacroStats;
begin
// clear references
AVLNode:=Macros.FindLowest;
while AVLNode<>nil do begin
MacroNode:=TCompilerMacroStats(AVLNode.Data);
if MacroNode.LastDefineNode=Node then
MacroNode.LastDefineNode:=nil;
if MacroNode.LastReadNode=Node then
MacroNode.LastReadNode:=nil;
AVLNode:=Macros.FindSuccessor(AVLNode);
if Macros<>nil then begin
AVLNode:=Macros.FindLowest;
while AVLNode<>nil do begin
MacroNode:=TCompilerMacroStats(AVLNode.Data);
if MacroNode.LastDefineNode=Node then
MacroNode.LastDefineNode:=nil;
if MacroNode.LastReadNode=Node then
MacroNode.LastReadNode:=nil;
AVLNode:=Macros.FindSuccessor(AVLNode);
end;
end;
// free node
@ -2415,6 +2459,41 @@ begin
Result:=CompareIdentifierPtrs(@Src[p],Identifier)=0;
end;
function TCompilerDirectivesTree.NodeIsEmpty(Node: TCodeTreeNode;
IgnoreComments: boolean): boolean;
var
DirectiveEndPos: LongInt;
begin
if (Node=nil) then exit(true);
if Node.FirstChild<>nil then exit(false);
case Node.Desc of
cdnNone: exit(true);
cdnRoot: exit(false); // root is never empty, can not be deleted
cdnDefine: exit(true);
cdnIf,
cdnElseIf,
cdnElse:
begin
if Node.NextBrother=nil then exit(false); // maybe continued in another file
MoveCursorToPos(Node.StartPos);
// skip directive
ReadNextAtom;
DirectiveEndPos:=SrcPos;
// read the following atom (token or directive)
ReadNextAtom;
if AtomStart=Node.NextBrother.StartPos then begin
if IgnoreComments then
exit(true)
else if FindNextNonSpace(Src,DirectiveEndPos)<AtomStart then
exit(false)
else
exit(true);
end;
end;
cdnEnd: exit(false);
end;
end;
function TCompilerDirectivesTree.FindNodeAtPos(p: integer): TCodeTreeNode;
begin
Result:=Tree.Root;

4
components/codetools/examples/replaceresourcedirectives.lpi
View File

@ -27,10 +27,10 @@
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="LCL"/>
<PackageName Value="CodeTools"/>
</Item1>
<Item2>
<PackageName Value="CodeTools"/>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="1">

18
components/codetools/examples/replaceresourcedirectives.lpr
View File

@ -45,7 +45,7 @@ begin
Code:=CodeToolBoss.LoadFile(Filename,false,false);
if Code=nil then
raise Exception.Create('loading failed '+Filename);
if not CodeToolBoss.AddResourceDirective(Code,'*.res',false,
'{$IFDEF SomePlatform}{$R *.res}{$ENDIF}')
then begin
@ -58,16 +58,28 @@ begin
if not CodeToolBoss.FindResourceDirective(Code,1,1,
NewCode,NewX,NewY,NewTopLine,'',false) then
begin
writeln('FAILED: did not find the resource');
writeln('FAILED: did not find any resource directive');
if CodeToolBoss.ErrorMessage<>'' then
writeln('CodeToolBoss.ErrorMessage=',CodeToolBoss.ErrorMessage);
halt;
end;
// write the new source:
writeln('---------BEFORE REMOVE-------------');
writeln(Code.Source);
writeln('-----------------------------------');
writeln(NewCode.Filename,' X=',NewX,' Y=',NewY);
if not CodeToolBoss.RemoveDirective(NewCode,NewX,NewY,true) then begin
writeln('FAILED to remove resource directive');
if CodeToolBoss.ErrorMessage<>'' then
writeln('CodeToolBoss.ErrorMessage=',CodeToolBoss.ErrorMessage);
halt;
end;
// write the new source:
writeln('-----------------------------------');
writeln('---------AFTER REMOVE---------------');
writeln(Code.Source);
writeln('-----------------------------------');
end.

4
components/daemon/lazdaemon.pas
View File

@ -7,13 +7,13 @@ unit lazdaemon;
interface
uses
reglazdaemon, daemonapp, lazdaemonapp, LazarusPackageIntf;
RegLazDaemon, daemonapp, lazdaemonapp, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('reglazdaemon', @reglazdaemon.Register);
RegisterUnit('RegLazDaemon', @RegLazDaemon.Register);
end;
initialization

10
components/daemon/reglazdaemon.pp
View File

@ -10,20 +10,18 @@
* *
*****************************************************************************
}
unit reglazdaemon;
unit RegLazDaemon;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FormEditingIntf, projectintf,newitemintf, lazideintf,
controls, forms;
Classes, SysUtils, FormEditingIntf, ProjectIntf, NewItemIntf, LazIDEIntf,
Controls, Forms;
Type
{ TDaemonFileDescriptor }
{ TDaemonMapperDescriptor }
TDaemonMapperDescriptor = Class(TFileDescPascalUnitWithResource)
@ -35,6 +33,8 @@ Type
function GetImplementationSource(const Filename, SourceName, ResourceName: string): string; override;
end;
{ TDaemonFileDescriptor }
TDaemonFileDescriptor = Class(TFileDescPascalUnitWithResource)
Public
Constructor Create; override;

4
ide/projectopts.pp
View File

@ -461,7 +461,7 @@ begin
TargetFilename := TargetFileEdit.Text;
UseAppBundle := UseAppBundleCheckBox.Checked;
XPManifest.UseManifest := UseXPManifestCheckBox.Checked;
Project.XPManifest.UpdateMainSourceFile(Project.MainFilename);
XPManifest.UpdateMainSourceFile(Project.MainFilename);
end;
// flags
@ -511,7 +511,7 @@ begin
Project.VersionInfo.CopyrightString:=CopyrightEdit.Text;
Project.VersionInfo.HexLang:=MSLanguageToHex(LanguageSelectionComboBox.Text);
Project.VersionInfo.HexCharSet:=MSCharacterSetToHex(CharacterSetComboBox.Text);
if Project.VersionInfo.UseVersionInfo and Project.VersionInfo.Modified then
if Project.VersionInfo.Modified then
Project.VersionInfo.UpdateMainSourceFile(Project.MainFilename);
end;

2
ide/projectopts_new.pp
View File

@ -515,7 +515,7 @@ begin
Project.VersionInfo.CopyrightString:=CopyrightEdit.Text;
Project.VersionInfo.HexLang:=MSLanguageToHex(LanguageSelectionComboBox.Text);
Project.VersionInfo.HexCharSet:=MSCharacterSetToHex(CharacterSetComboBox.Text);
if Project.VersionInfo.UseVersionInfo and Project.VersionInfo.Modified then
if Project.VersionInfo.Modified then
Project.VersionInfo.UpdateMainSourceFile(Project.MainFilename);
end;

4
ide/uniteditor.pp
View File

@ -1425,7 +1425,7 @@ begin
inc(SourceCompletionCaretXY.x,length(AChar));
SourceCompletionTimer.AutoEnabled:=true;
end;
//DebugLn(['TSourceEditor.ProcessCommand AddCHar=',AddCHar]);
//DebugLn(['TSourceEditor.ProcessCommand ecChar AddChar=',AddChar]);
if not AddChar then Command:=ecNone;
end;
@ -1433,6 +1433,7 @@ begin
begin
AddChar:=true;
if AutoCompleteChar(aChar,AddChar,acoLineBreak) then ;
//DebugLn(['TSourceEditor.ProcessCommand ecLineBreak AddChar=',AddChar]);
if not AddChar then Command:=ecNone;
end;
end;
@ -2145,6 +2146,7 @@ begin
and (FCodeTemplates.CompletionAttributes[i].IndexOfName(CatName)>=0)
then begin
Result:=true;
DebugLn(['TSourceEditor.AutoCompleteChar ',AToken,' SrcToken=',SrcToken,' CatName=',CatName,' Index=',FCodeTemplates.CompletionAttributes[i].IndexOfName(CatName)]);
FCodeTemplates.ExecuteCompletion(AToken,FEditor);
AddChar:=not FCodeTemplates.CompletionAttributes[i].IndexOfName(
AutoCompleteOptionNames[acoRemoveChar])>=0;

40
ide/w32manifest.pas
View File

@ -118,45 +118,39 @@ end;
function TProjectXPManifest.UpdateMainSourceFile(const AFilename: string): TModalResult;
var
NewX, NewY, NewTopLine: integer;
ManifestCodeBuf: TCodeBuffer;
CodePos: TCodeXYPosition;
ManifestCodeBuf, NewCode: TCodeBuffer;
Filename: String;
begin
Result := mrCancel;
ManifestCodeBuf := CodeToolBoss.LoadFile(AFilename,false,false);
if ManifestCodeBuf <> nil then
begin
SetFileNames(AFilename);
if not CodeToolBoss.FindResourceDirective(ManifestCodeBuf, 1, 1,
ManifestCodeBuf, NewX, NewY,
NewTopLine, ExtractFileName(resFileName)) then
Filename:=ExtractFileName(resFileName);
DebugLn(['TProjectXPManifest.UpdateMainSourceFile ',Filename]);
if CodeToolBoss.FindResourceDirective(ManifestCodeBuf, 1, 1,
NewCode, NewX, NewY,
NewTopLine, Filename, false) then
begin
if UseManifest then
begin
if not CodeToolBoss.AddResourceDirective(ManifestCodeBuf, ExtractFileName(resFileName)) then
// there is a resource directive in the source
if not UseManifest then begin
if not CodeToolBoss.RemoveDirective(NewCode, NewX,NewY,true) then
begin
Messages.Add('Could not add "{$R'+ ExtractFileName(resFileName) +'"} to main source!');
Messages.Add('Could not remove "{$R'+ Filename +'"} from main source!');
exit;
end;
end;
end else
if not UseManifest then
end else if UseManifest then
begin
with CodeToolBoss.CurCodeTool do
if not CodeToolBoss.AddResourceDirective(ManifestCodeBuf,
Filename,false,'{$IFDEF WINDOWS}{$R '+Filename+'}{$ENDIF}') then
begin
CodeToolBoss.SourceChangeCache.MainScanner := Scanner;
CodePos.Code := ManifestCodeBuf;
CodePos.X := NewX;
CodePos.Y := NewY;
CaretToCleanPos(CodePos, NewX);
if CodeToolBoss.SourceChangeCache.Replace(gtNone, gtNone, NewX, NewX + Length(ExtractFileName(resFileName)) + 5, '') then
begin
if not CodeToolBoss.SourceChangeCache.Apply then
exit;
end else
exit;
Messages.Add('Could not add "{$R'+ Filename +'"} to main source!');
exit;
end;
end;
end;
DebugLn(['TProjectXPManifest.UpdateMainSourceFile END ',ManifestCodeBuf.Source]);
Result := mrOk;
end;

58
ide/w32versioninfo.pas
View File

@ -796,28 +796,46 @@ end;
TProjectVersionInfo UpdateMainSourceFile
-----------------------------------------------------------------------------}
function TProjectVersionInfo.UpdateMainSourceFile(const AFilename: string
): TModalResult;
): TModalResult;
var
NewX, NewY, NewTopLine: integer;
VersionInfoCodeBuf: TCodeBuffer;
NewX, NewY, NewTopLine: integer;
VersionInfoCodeBuf: TCodeBuffer;
Filename: String;
NewCode: TCodeBuffer;
begin
Result := mrCancel;
VersionInfoCodeBuf:=CodeToolBoss.LoadFile(AFilename,false,false);
if VersionInfoCodeBuf=nil then exit;
SetFileNames(AFilename);
if not CodeToolBoss.FindResourceDirective(VersionInfoCodeBuf,1,1,
VersionInfoCodeBuf,NewX,NewY,
NewTopLine,ExtractFileName(resFilename)) then
begin
if not CodeToolBoss.AddResourceDirective(VersionInfoCodeBuf,
ExtractFileName(resFilename)) then
begin
VersionInfoMessages.Add('Could not add "{$R '
+ ExtractFileName(resFilename)+'}" to main source!');
exit;
end
end;
Result:=mrOk;
Result := mrCancel;
VersionInfoCodeBuf:=CodeToolBoss.LoadFile(AFilename,false,false);
if VersionInfoCodeBuf=nil then exit;
SetFileNames(AFilename);
Filename:=ExtractFileName(resFilename);
//DebugLn(['TProjectVersionInfo.UpdateMainSourceFile ',Filename,' UseVersionInfo=',UseVersionInfo]);
if CodeToolBoss.FindResourceDirective(VersionInfoCodeBuf,1,1,
NewCode,NewX,NewY,
NewTopLine,Filename,false) then
begin
if not UseVersionInfo then begin
//DebugLn(['TProjectVersionInfo.UpdateMainSourceFile removing ',NewCode.Filename,' X=',NewX,' Y=',NewY]);
if not CodeToolBoss.RemoveDirective(NewCode,NewX,NewY,true) then
begin
DebugLn(['TProjectVersionInfo.UpdateMainSourceFile FAILED removing']);
VersionInfoMessages.Add('Could not emove "{$R '
+ Filename+'}" from main source!');
exit;
end
end;
end else if UseVersionInfo then begin
//DebugLn(['TProjectVersionInfo.UpdateMainSourceFile adding ',AFilename]);
if not CodeToolBoss.AddResourceDirective(VersionInfoCodeBuf,
Filename,false,'{$IFDEF WINDOWS}{$R '+Filename+'}{$ENDIF}') then
begin
DebugLn(['TProjectVersionInfo.UpdateMainSourceFile FAILED adding']);
VersionInfoMessages.Add('Could not add "{$R '
+ Filename+'}" to main source!');
exit;
end
end;
//DebugLn(['TProjectVersionInfo.UpdateMainSourceFile ',VersionInfoCodeBuf.Source]);
Result:=mrOk;
end;
{-----------------------------------------------------------------------------