implemented adding Application.Title:= statements

git-svn-id: trunk@5334 -
This commit is contained in:
mattias 2004-03-20 12:55:48 +00:00
parent 75d0b90eab
commit bcf68cee11
5 changed files with 429 additions and 143 deletions

View File

@ -2532,22 +2532,41 @@ begin
end;
function StringToPascalConst(const s: string): string;
// converts s to
function Convert(var DestStr: string): integer;
var
SrcLen, SrcPos, DestPos: integer;
c: char;
i: integer;
InString: Boolean;
begin
SrcLen:=length(s);
DestPos:=0;
InString:=false;
for SrcPos:=1 to SrcLen do begin
inc(DestPos);
c:=s[SrcPos];
if c>=' ' then begin
// normal char
if not InString then begin
if DestStr<>'' then DestStr[DestPos]:='''';
inc(DestPos);
InString:=true;
end;
if DestStr<>'' then
DestStr[DestPos]:=c;
if c='''' then begin
if DestStr<>'' then DestStr[DestPos]:='''';
inc(DestPos);
end;
end else begin
// special char
if InString then begin
if DestStr<>'' then DestStr[DestPos]:='''';
inc(DestPos);
InString:=false;
end;
if DestStr<>'' then
DestStr[DestPos]:='#';
inc(DestPos);
@ -2566,6 +2585,11 @@ function StringToPascalConst(const s: string): string;
DestStr[DestPos]:=chr((i mod 10)+ord('0'));
end;
end;
if InString then begin
inc(DestPos);
if DestStr<>'' then DestStr[DestPos]:='''';
InString:=false;
end;
Result:=DestPos;
end;

View File

@ -365,7 +365,7 @@ type
// Delphi to Lazarus conversion
function ConvertDelphiToLazarusSource(Code: TCodeBuffer;
AddLRSCode: boolean): boolean;
// Application.Createform(ClassName,VarName) statements in program source
function FindCreateFormStatement(Code: TCodeBuffer; StartPos: integer;
const AClassName, AVarName: string;
@ -381,6 +381,13 @@ type
function ListAllCreateFormStatements(Code: TCodeBuffer): TStrings;
function SetAllCreateFromStatements(Code: TCodeBuffer;
List: TStrings): boolean;
// Application.Title:= statements in program source
function GetApplicationTitleStatement(Code: TCodeBuffer;
var Title: string): boolean;
function SetApplicationTitleStatement(Code: TCodeBuffer;
const NewTitle: string): boolean;
function RemoveApplicationTitleStatement(Code: TCodeBuffer): boolean;
// forms
function RenameForm(Code: TCodeBuffer;
@ -2200,6 +2207,57 @@ begin
end;
end;
function TCodeToolManager.GetApplicationTitleStatement(Code: TCodeBuffer;
var Title: string): boolean;
var
StartPos, StringConstStartPos, EndPos: integer;
begin
Result:=false;
{$IFDEF CTDEBUG}
writeln('TCodeToolManager.GetApplicationTitleStatement A ',Code.Filename);
{$ENDIF}
if not InitCurCodeTool(Code) then exit;
try
Result:=FCurCodeTool.FindApplicationTitleStatement(StartPos,
StringConstStartPos,EndPos);
Result:=FCurCodeTool.GetApplicationTitleStatement(StringConstStartPos,
EndPos,Title);
except
on e: Exception do Result:=HandleException(e);
end;
end;
function TCodeToolManager.SetApplicationTitleStatement(Code: TCodeBuffer;
const NewTitle: string): boolean;
begin
Result:=false;
{$IFDEF CTDEBUG}
writeln('TCodeToolManager.SetApplicationTitleStatement A ',Code.Filename);
{$ENDIF}
if not InitCurCodeTool(Code) then exit;
try
Result:=FCurCodeTool.SetApplicationTitleStatement(NewTitle,
SourceChangeCache);
except
on e: Exception do Result:=HandleException(e);
end;
end;
function TCodeToolManager.RemoveApplicationTitleStatement(Code: TCodeBuffer
): boolean;
begin
Result:=false;
{$IFDEF CTDEBUG}
writeln('TCodeToolManager.RemoveApplicationTitleStatement A ',Code.Filename);
{$ENDIF}
if not InitCurCodeTool(Code) then exit;
try
Result:=FCurCodeTool.RemoveApplicationTitleStatement(SourceChangeCache);
except
on e: Exception do Result:=HandleException(e);
end;
end;
function TCodeToolManager.RenameForm(Code: TCodeBuffer; const OldFormName,
OldFormClassName: string; const NewFormName, NewFormClassName: string
): boolean;

View File

@ -118,7 +118,7 @@ type
function CheckLFM(LFMBuf: TCodeBuffer; var LFMTree: TLFMTree;
const OnGetDefineProperties: TOnGetDefineProperties): boolean;
// createform
// Application.Createform statements
function FindCreateFormStatement(StartPos: integer;
const UpperClassName, UpperVarName: string;
var Position: TAtomPosition): integer; // 0=found, -1=not found, 1=found, but wrong classname
@ -134,6 +134,16 @@ type
function ListAllCreateFormStatements: TStrings;
function SetAllCreateFromStatements(List: TStrings;
SourceChangeCache: TSourceChangeCache): boolean;
// Application.Title:=<string const> statements
function FindApplicationTitleStatement(var StartPos, StringConstStartPos,
EndPos: integer): boolean;
function GetApplicationTitleStatement(StringConstStartPos, EndPos: integer;
var Title: string): boolean;
function SetApplicationTitleStatement(const NewTitle: string;
SourceChangeCache: TSourceChangeCache): boolean;
function RemoveApplicationTitleStatement(
SourceChangeCache: TSourceChangeCache): boolean;
// forms
function RenameForm(const OldFormName, OldFormClassName: string;
@ -186,7 +196,9 @@ type
function ReplaceCode(const StartPos, EndPos: TCodeXYPosition;
const NewCode: string;
SourceChangeCache: TSourceChangeCache): boolean;
function GetStringConstAsFormatString(StartPos, EndPos: integer;
var FormatStringConstant,FormatParameters: string): boolean;
// resource strings
function GatherResourceStringSections(const CursorPos: TCodeXYPosition;
PositionList: TCodeXYPositions): boolean;
@ -201,7 +213,7 @@ type
function FindNearestResourceString(const CursorPos,
SectionPos: TCodeXYPosition;
var NearestPos: TCodeXYPosition): boolean;
function AddResourcestring(const SectionPos: TCodeXYPosition;
function AddResourceString(const SectionPos: TCodeXYPosition;
const NewIdentifier, NewValue: string;
InsertPolicy: TResourcestringInsertPolicy;
const NearestPos: TCodeXYPosition;
@ -1511,6 +1523,123 @@ begin
Result:= Result and SourceChangeCache.Apply;
end;
function TStandardCodeTool.FindApplicationTitleStatement(var StartPos,
StringConstStartPos, EndPos: integer): boolean;
var
MainBeginNode: TCodeTreeNode;
Position: Integer;
begin
Result:=false;
StartPos:=-1;
StringConstStartPos:=-1;
EndPos:=-1;
BuildTree(false);
MainBeginNode:=FindMainBeginEndNode;
if MainBeginNode=nil then exit;
Position:=MainBeginNode.StartPos;
if Position<1 then exit;
MoveCursorToCleanPos(Position);
repeat
ReadNextAtom;
if UpAtomIs('APPLICATION') then begin
StartPos:=CurPos.StartPos;
if ReadNextAtomIsChar('.') and ReadNextUpAtomIs('TITLE')
and ReadNextUpAtomIs(':=') then begin
// read till semicolon or end
repeat
ReadNextAtom;
if StringConstStartPos<1 then
StringConstStartPos:=CurPos.StartPos;
EndPos:=CurPos.EndPos;
if CurPos.Flag in [cafEnd,cafSemicolon] then begin
Result:=true;
exit;
end;
until CurPos.StartPos>SrcLen;
end;
end;
until (CurPos.StartPos>SrcLen);
end;
function TStandardCodeTool.GetApplicationTitleStatement(StringConstStartPos,
EndPos: integer; var Title: string): boolean;
var
FormatStringParams: string;
begin
Result:=false;
Title:='';
if (StringConstStartPos<1) or (StringConstStartPos>SrcLen) then exit;
MoveCursorToCleanPos(StringConstStartPos);
ReadNextAtom;
if not AtomIsStringConstant then exit;
Result:=GetStringConstAsFormatString(StringConstStartPos,EndPos,Title,
FormatStringParams);
end;
function TStandardCodeTool.SetApplicationTitleStatement(const NewTitle: string;
SourceChangeCache: TSourceChangeCache): boolean;
var
StartPos, StringConstStartPos, EndPos: integer;
OldExists: Boolean;
NewStatement: String;
Indent: Integer;
MainBeginNode: TCodeTreeNode;
begin
Result:=false;
// search old Application.Title:= statement
OldExists:=FindApplicationTitleStatement(StartPos,StringConstStartPos,EndPos);
if OldExists then begin
// replace old statement
Indent:=0;
Indent:=GetLineIndent(Src,StartPos)
end else begin
// insert as first line in program begin..end block
MainBeginNode:=FindMainBeginEndNode;
if MainBeginNode=nil then exit;
MoveCursorToNodeStart(MainBeginNode);
ReadNextAtom;
StartPos:=CurPos.EndPos;
EndPos:=StartPos;
Indent:=GetLineIndent(Src,StartPos)
+SourceChangeCache.BeautifyCodeOptions.Indent;
end;
// create statement
NewStatement:='Application.Title:='+StringToPascalConst(NewTitle)+';';
NewStatement:=SourceChangeCache.BeautifyCodeOptions.BeautifyStatement(
NewStatement,Indent);
SourceChangeCache.MainScanner:=Scanner;
if not SourceChangeCache.Replace(gtNewLine,gtNewLine,StartPos,EndPos,
NewStatement)
then
exit;
if not SourceChangeCache.Apply then exit;
Result:=true;
end;
function TStandardCodeTool.RemoveApplicationTitleStatement(
SourceChangeCache: TSourceChangeCache): boolean;
var
StartPos, StringConstStartPos, EndPos: integer;
OldExists: Boolean;
FromPos: Integer;
ToPos: Integer;
begin
Result:=false;
// search old Application.Title:= statement
OldExists:=FindApplicationTitleStatement(StartPos,StringConstStartPos,EndPos);
if not OldExists then begin
Result:=true;
exit;
end;
// -> delete whole line
FromPos:=FindLineEndOrCodeInFrontOfPosition(StartPos);
ToPos:=FindFirstLineEndAfterInCode(EndPos);
SourceChangeCache.MainScanner:=Scanner;
if not SourceChangeCache.Replace(gtNone,gtNone,FromPos,ToPos,'') then exit;
if not SourceChangeCache.Apply then exit;
Result:=true;
end;
function TStandardCodeTool.RenameForm(const OldFormName,
OldFormClassName: string; const NewFormName, NewFormClassName: string;
SourceChangeCache: TSourceChangeCache): boolean;
@ -1882,6 +2011,140 @@ begin
RaiseException('TStandardCodeTool.ReplaceCode not implemented yet');
end;
function TStandardCodeTool.GetStringConstAsFormatString(StartPos,
EndPos: integer; var FormatStringConstant, FormatParameters: string
): boolean;
{ Converts a string constant into the parameters for a Format call of the
system unit.
Examples:
'Hallo' -> "Hallo", ""
'A'+IntToStr(1) -> "A%s", "IntToStr(1)"
'A%B'#13#10 -> "A%sB%s", "'%', #13#10"
}
procedure AddChar(c: char);
begin
FormatStringConstant:=FormatStringConstant+c;
end;
procedure AddParameter(const NewParam: string);
begin
FormatStringConstant:=FormatStringConstant+'%s';
if FormatParameters<>'' then
FormatParameters:=FormatParameters+',';
FormatParameters:=FormatParameters+NewParam;
end;
procedure AddParameter(ParamStartPos,ParamEndPos: integer);
begin
AddParameter(copy(Src,ParamStartPos,ParamEndPos-ParamStartPos));
end;
procedure ConvertStringConstant;
var
APos: Integer;
CharConstStart: Integer;
begin
APos:=CurPos.StartPos;
while APos<EndPos do begin
if Src[APos]='''' then begin
// read string constant
inc(APos);
while APos<EndPos do begin
case Src[APos] of
'''':
if (APos<EndPos-1) and (Src[APos+1]='''') then begin
// a double ' means a single '
AddChar('''');
AddChar('''');
inc(APos,2);
end else begin
// a single ' means end of string constant
inc(APos);
break;
end;
'"':
begin
AddParameter('''"''');
inc(APos);
end;
else
begin
// normal char
AddChar(Src[APos]);
inc(APos);
end;
end;
end;
end else if Src[APos]='#' then begin
CharConstStart:=APos;
repeat
// read char constant
inc(APos);
if APos<EndPos then begin
if IsNumberChar[Src[APos]] then begin
// read decimal number
while (APos<EndPos) and IsNumberChar[Src[APos]] do
inc(APos);
end else if Src[APos]='$' then begin
// read hexnumber
while (APos<EndPos) and IsHexNumberChar[Src[APos]] do
inc(APos);
end;
end;
until (APos>=EndPos) or (Src[APos]<>'#');
AddParameter(CharConstStart,APos);
end else
break;
end;
end;
procedure ConvertOther;
var
ParamStartPos: Integer;
ParamEndPos: Integer;
begin
// read till next string constant
ParamStartPos:=CurPos.StartPos;
ParamEndPos:=ParamStartPos;
while (not AtomIsStringConstant) and (CurPos.EndPos<=EndPos) do begin
if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then
ReadTilBracketClose(true);
if not AtomIsChar('+') then ParamEndPos:=CurPos.EndPos;
ReadNextAtom;
end;
if ParamEndPos>ParamStartPos then
AddParameter(ParamStartPos,ParamEndPos);
if AtomIsStringConstant then UndoReadNextAtom;
end;
begin
Result:=false;
// read string constants and convert it
FormatStringConstant:='';
FormatParameters:='';
MoveCursorToCleanPos(StartPos);
if EndPos>SrcLen then EndPos:=SrcLen+1;
repeat
ReadNextAtom;
if (CurPos.EndPos>EndPos) then break;
if AtomIsStringConstant then begin
// a string constant
ConvertStringConstant;
end else if AtomIsChar('+') then begin
// simply ignore
end else if (CurPos.Flag=cafRoundBracketOpen) or AtomIsIdentifier(false)
then begin
// add as parameter
ConvertOther;
end else
// string constant end
break;
until false;
Result:=FormatStringConstant<>'';
end;
function TStandardCodeTool.GatherResourceStringSections(
const CursorPos: TCodeXYPosition; PositionList: TCodeXYPositions): boolean;
@ -2022,141 +2285,16 @@ end;
function TStandardCodeTool.StringConstToFormatString(const StartCursorPos,
EndCursorPos: TCodeXYPosition; var FormatStringConstant,
FormatParameters: string): boolean;
{ Converts a string constant into the parameters for a Format call of the
system unit.
Examples:
'Hallo' -> "Hallo", ""
'A'+IntToStr(1) -> "A%s", "IntToStr(1)"
'A%B'#13#10 -> "A%sB%s", "'%', #13#10"
}
var
StartPos, EndPos: integer;
procedure AddChar(c: char);
begin
FormatStringConstant:=FormatStringConstant+c;
end;
procedure AddParameter(const NewParam: string);
begin
FormatStringConstant:=FormatStringConstant+'%s';
if FormatParameters<>'' then
FormatParameters:=FormatParameters+',';
FormatParameters:=FormatParameters+NewParam;
end;
procedure AddParameter(ParamStartPos,ParamEndPos: integer);
begin
AddParameter(copy(Src,ParamStartPos,ParamEndPos-ParamStartPos));
end;
procedure ConvertStringConstant;
var
APos: Integer;
CharConstStart: Integer;
begin
APos:=CurPos.StartPos;
while APos<EndPos do begin
if Src[APos]='''' then begin
// read string constant
inc(APos);
while APos<EndPos do begin
case Src[APos] of
'''':
if (APos<EndPos-1) and (Src[APos+1]='''') then begin
// a double ' means a single '
AddChar('''');
AddChar('''');
inc(APos,2);
end else begin
// a single ' means end of string constant
inc(APos);
break;
end;
'"':
begin
AddParameter('''"''');
inc(APos);
end;
else
begin
// normal char
AddChar(Src[APos]);
inc(APos);
end;
end;
end;
end else if Src[APos]='#' then begin
CharConstStart:=APos;
repeat
// read char constant
inc(APos);
if APos<EndPos then begin
if IsNumberChar[Src[APos]] then begin
// read decimal number
while (APos<EndPos) and IsNumberChar[Src[APos]] do
inc(APos);
end else if Src[APos]='$' then begin
// read hexnumber
while (APos<EndPos) and IsHexNumberChar[Src[APos]] do
inc(APos);
end;
end;
until (APos>=EndPos) or (Src[APos]<>'#');
AddParameter(CharConstStart,APos);
end else
break;
end;
end;
procedure ConvertOther;
var
ParamStartPos: Integer;
ParamEndPos: Integer;
begin
// read till next string constant
ParamStartPos:=CurPos.StartPos;
ParamEndPos:=ParamStartPos;
while (not AtomIsStringConstant) and (CurPos.EndPos<=EndPos) do begin
if CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen] then
ReadTilBracketClose(true);
if not AtomIsChar('+') then ParamEndPos:=CurPos.EndPos;
ReadNextAtom;
end;
if ParamEndPos>ParamStartPos then
AddParameter(ParamStartPos,ParamEndPos);
if AtomIsStringConstant then UndoReadNextAtom;
end;
var
Dummy: Integer;
StartPos,EndPos,Dummy: Integer;
begin
Result:=false;
// parse source and find clean positions
BuildTreeAndGetCleanPos(trAll,StartCursorPos,StartPos,[]);
Dummy:=CaretToCleanPos(EndCursorPos, EndPos);
if (Dummy<>0) and (Dummy<>-1) then exit;
// read string constants and convert it
FormatStringConstant:='';
FormatParameters:='';
MoveCursorToCleanPos(StartPos);
if EndPos>SrcLen then EndPos:=SrcLen+1;
repeat
ReadNextAtom;
if (CurPos.EndPos>EndPos) then break;
if AtomIsStringConstant then begin
// a string constant
ConvertStringConstant;
end else if AtomIsChar('+') then begin
// simply ignore
end else begin
// add rest as parameter
ConvertOther;
end;
until false;
Result:=FormatStringConstant<>'';
Result:=GetStringConstAsFormatString(StartPos,EndPos,FormatStringConstant,
FormatParameters);
end;
function TStandardCodeTool.HasInterfaceRegisterProc(var HasRegisterProc: boolean
@ -2528,7 +2666,7 @@ begin
Result:=true;
end;
function TStandardCodeTool.AddResourcestring(const SectionPos: TCodeXYPosition;
function TStandardCodeTool.AddResourceString(const SectionPos: TCodeXYPosition;
const NewIdentifier, NewValue: string;
InsertPolicy: TResourcestringInsertPolicy;
const NearestPos: TCodeXYPosition;

View File

@ -389,6 +389,10 @@ type
function ReadProject(const LPIFilename: string): TModalResult;
function WriteProject(ProjectWriteFlags: TProjectWriteFlags;
const OverrideProjectInfoFile: string): TModalResult;
// title
function GetDefaultTitle: string;
function TitleIsDefault: boolean;
// units
function UnitCount:integer;
@ -421,7 +425,6 @@ type
procedure CloseEditorIndex(EditorIndex:integer);
procedure InsertEditorIndex(EditorIndex:integer);
procedure MoveEditorIndex(OldEditorIndex, NewEditorIndex: integer);
// Application.CreateForm statements
function AddCreateFormToProjectFile(const AClassName, AName:string):boolean;
@ -1498,6 +1501,16 @@ begin
until Result<>mrRetry;
end;
function TProject.GetDefaultTitle: string;
begin
Result:=ExtractFilenameOnly(ProjectInfoFile);
end;
function TProject.TitleIsDefault: boolean;
begin
Result:=(Title='') or (Title=GetDefaultTitle);
end;
{------------------------------------------------------------------------------
TProject ReadProject
------------------------------------------------------------------------------}
@ -2833,6 +2846,9 @@ end.
{
$Log$
Revision 1.152 2004/03/20 12:55:48 mattias
implemented adding Application.Title:= statements
Revision 1.151 2004/03/17 11:28:35 mattias
fixed setting project LCLWidgetSet in defines

View File

@ -92,9 +92,11 @@ type
function FirstAvailFormSelected: integer;
procedure SelectOnlyThisAutoCreateForm(Index: integer);
function GetAutoCreatedFormsList: TStrings;
procedure SetAutoCreateForms;
function GetProjectTitle: string;
function SetAutoCreateForms: boolean;
function SetProjectTitle: boolean;
public
constructor Create(AOwner: TComponent); override;
constructor Create(TheOwner: TComponent); override;
property Project: TProject read FProject write SetProject;
end;
@ -117,9 +119,9 @@ end;
{ TProjectOptionsDialog }
constructor TProjectOptionsDialog.Create(AOwner: TComponent);
constructor TProjectOptionsDialog.Create(TheOwner: TComponent);
begin
inherited Create(AOwner);
inherited Create(TheOwner);
if LazarusResources.Find(ClassName)=nil then begin
Width:=430;
Height:=375;
@ -127,9 +129,7 @@ begin
OnResize:= @ProjectOptionsResize;
OnClose:= @ProjectOptionsClose;
Caption:=dlgProjectOptions;
Constraints.MinWidth:= 400;
Constraints.MinHeight:= 300;
NoteBook:=TNoteBook.Create(Self);
with NoteBook do begin
Parent:=Self;
@ -470,6 +470,7 @@ begin
Project.AutoCreateForms:=FormsAutoCreateNewFormsCheckBox.Checked;
SetAutoCreateForms;
SetProjectTitle;
end;
IDEDialogLayoutList.SaveLayout(Self);
@ -499,6 +500,15 @@ begin
end;
end;
function TProjectOptionsDialog.GetProjectTitle: string;
begin
Result:='';
if (FProject=nil) or (FProject.MainUnitID<0) then begin
exit;
end;
CodeToolBoss.GetApplicationTitleStatement(FProject.MainUnitInfo.Source,Result);
end;
procedure TProjectOptionsDialog.FillAutoCreateFormsListbox;
var sl: TStrings;
begin
@ -671,10 +681,11 @@ begin
end;
end;
procedure TProjectOptionsDialog.SetAutoCreateForms;
function TProjectOptionsDialog.SetAutoCreateForms: boolean;
var i: integer;
OldList: TStrings;
begin
Result:=true;
if (Project.MainUnitID < 0) or (Project.ProjectType in [ptCustomProgram]) then
exit;
OldList:= GetAutoCreatedFormsList;
@ -695,13 +706,52 @@ begin
begin
MessageDlg(lisProjOptsError,
Format(lisProjOptsUnableToChangeTheAutoCreateFormList, [LineEnding]),
mtError, [mbCancel], 0);
mtWarning, [mbCancel], 0);
Result:=false;
exit;
end;
finally
OldList.Free;
end;
end;
function TProjectOptionsDialog.SetProjectTitle: boolean;
var
OldTitle: String;
begin
Result:=true;
if (Project.MainUnitID < 0) or (Project.ProjectType in [ptCustomProgram]) then
exit;
OldTitle:=GetProjectTitle;
if (OldTitle='') and Project.TitleIsDefault then exit;
if (OldTitle<>Project.Title) and (not Project.TitleIsDefault) then begin
// set Application.Title:= statement
if not CodeToolBoss.SetApplicationTitleStatement(
Project.MainUnitInfo.Source, Project.Title) then
begin
MessageDlg(lisProjOptsError,
'Unable to change project title in source.'#13
+CodeToolBoss.ErrorMessage,
mtWarning, [mbCancel], 0);
Result:=false;
end;
end;
if (OldTitle<>'') and Project.TitleIsDefault then begin
// delete title
if not CodeToolBoss.RemoveApplicationTitleStatement(
Project.MainUnitInfo.Source) then
begin
MessageDlg(lisProjOptsError,
'Unable to remove project title from source.'#13
+CodeToolBoss.ErrorMessage,
mtWarning, [mbCancel], 0);
Result:=false;
end;
end;
end;
initialization
{$I projectopts.lrs}